Function IsValidObject(ByVal oObject)
IsValidObject = False
If IsObject(oObject) Then
If Not oObject Is Nothing Then
IsValidObject = True
End If
End If
End Function
Function MomCreateObject(ByVal sProgramId)
Dim oError
Set oError = New Error
On Error Resume Next
Set MomCreateObject = CreateObject(sProgramId)
oError.Save
On Error GoTo 0
If oError.Number <> 0 Then ThrowScriptError "Unable to create automation object '" & sProgramId & "'", oError
End Function
Public Function GetSQLServiceName(sInstance)
If sInstance = SQL_DEFAULT Then
GetSQLServiceName = SQL_DEFAULT
Else
GetSQLServiceName = "MSSQL$" & sInstance
End If
End Function
'The function returns service or "Unknown" state
'Input:
' server - compute name
' service - system service name
'Output:
' service state or "Unknown" state
Function GetServiceState( sTargetComputer, sServiceName)
On Error Resume Next
Dim sNamespace, sQuery, oWMI, objClasses, sState
sNamespace = "winmgmts://" & sTargetComputer & "/root/cimv2"
sQuery = "SELECT State FROM Win32_Service where Name = """ & EscapeWQLString(sServiceName) & """"
Set oWMI = GetObject(sNamespace)
Set objClasses = oWMI.ExecQuery(sQuery)
if objClasses.Count >= 1 Then
sState = GetFirstItemFromWMIQuery(objClasses).Properties_.Item("State")
End If
If Err.number <> 0 Or objClasses.Count = 0 Then
sState = "Unknown"
End If
Err.Clear
GetServiceState = sState
End Function
'#Include File:SQL2014Constants.vbs
Public Sub Save()
m_lNumber = Err.Number
m_sSource = Err.Source
m_sDescription = Err.Description
m_sHelpContext = Err.HelpContext
m_sHelpFile = Err.HelpFile
End Sub
Public Sub Raise()
Err.Raise m_lNumber, m_sSource, m_sDescription, m_sHelpFile, m_sHelpContext
End Sub
Public Sub Clear()
m_lNumber = 0
m_sSource = ""
m_sDescription = ""
m_sHelpContext = ""
m_sHelpFile = ""
End Sub
Public Default Property Get Number()
Number = m_lNumber
End Property
Public Property Get Source()
Source = m_sSource
End Property
Public Property Get Description()
Description = m_sDescription
End Property
Public Property Get HelpContext()
HelpContext = m_sHelpContext
End Property
Public Property Get HelpFile()
HelpFile = m_sHelpFile
End Property
End Class
Function ThrowScriptErrorNoAbort(ByVal sMessage, ByVal oErr)
On Error Resume Next
Dim oAPITemp
Set oAPITemp = MOMCreateObject("MOM.ScriptAPI")
oAPITemp.LogScriptEvent WScript.ScriptName, 4201, 1, sMessage & ". " & oErr.Description
End Function
Function ThrowScriptError(Byval sMessage, ByVal oErr)
On Error Resume Next
ThrowScriptErrorNoAbort sMessage, oErr
Quit()
End Function
Sub HandleError(customMessage)
Dim localLogger
If Not (Err.number = 0) Then
Set localLogger = new ScriptLogger
localLogger.LogFormattedError(customMessage)
Wscript.Quit 0
End If
End Sub
Function HandleErrorContinue(customMessage)
Dim localLogger
HandleErrorContinue = False
If Not (Err.number = 0) Then
Set localLogger = new ScriptLogger
localLogger.LogFormattedError(customMessage)
Err.Clear
HandleErrorContinue = True
End If
End Function
'#Include File:WMI.vbs
Function EscapeWQLString (ByVal strValue)
On Error Resume Next
Err.Clear
EscapeWQLString = Replace(strValue, "'", "\'")
End Function
Function WMIGetProperty(oWmi, sPropName, nCIMType, ErrAction)
Dim sValue, oWmiProp
If Not IsValidObject(oWmi) Then
If (ErrAction And ErrAction_ThrowError) = ErrAction_ThrowError Then _
ThrowScriptErrorNoAbort "Accessing property on invalid WMI object.", Err
If (ErrAction And ErrAction_Abort) = ErrAction_Abort Then _
Quit()
WMIGetProperty = ""
Exit Function
End If
On Error Resume Next
Set oWmiProp = oWmi.Properties_.Item(sPropName)
If Err.Number <> 0 Then
If (ErrAction And ErrAction_ThrowError) = ErrAction_ThrowError Then _
ThrowScriptErrorNoAbort "An error occurred while accessing WMI property: '" & sPropName & "'.", Err
If (ErrAction And ErrAction_Abort) = ErrAction_Abort Then _
Quit()
End If
On Error GoTo 0
If IsValidObject(oWmiProp) Then
sValue = oWmiProp.Value
If IsNull(sValue) Then
'
' If value is null, return blank to avoid any issues
'
WMIGetProperty = ""
Else
Select Case (oWmiProp.CIMType)
Case wbemCimtypeString, wbemCimtypeSint16, wbemCimtypeSint32, wbemCimtypeReal32, wbemCimtypeReal64, wbemCimtypeSint8, wbemCimtypeUint8, wbemCimtypeUint16, wbemCimtypeUint32, wbemCimtypeSint64, wbemCimtypeUint64:
If Not oWmiProp.IsArray Then
WMIGetProperty = Trim(CStr(sValue))
Else
WMIGetProperty = Join(sValue, ", ")
End If
Case wbemCimtypeBoolean:
If sValue = 1 Or UCase(sValue) = "TRUE" Then
WMIGetProperty = "True"
Else
WMIGetProperty = "False"
End If
Case wbemCimtypeDatetime:
Dim sTmpStrDate
'
' First attempt to convert the whole wmi date string
'
sTmpStrDate = Mid(sValue, 5, 2) & "/" & _
Mid(sValue, 7, 2) & "/" & _
Left(sValue, 4) & " " & _
Mid (sValue, 9, 2) & ":" & _
Mid(sValue, 11, 2) & ":" & _
Mid(sValue, 13, 2)
If IsDate(sTmpStrDate) Then
WMIGetProperty = CDate(sTmpStrDate)
Else
'
' Second, attempt just to convert the YYYYMMDD
'
sTmpStrDate = Mid(sValue, 5, 2) & "/" & _
Mid(sValue, 7, 2) & "/" & _
Left(sValue, 4)
If IsDate(sTmpStrDate) Then
WMIGetProperty = CDate(sTmpStrDate)
Else
'
' Nothing works - return passed in string
'
WMIGetProperty = sValue
End If
End If
Case Else:
WMIGetProperty = ""
End Select
End If
Else
If (ErrAction And ErrAction_ThrowError) = ErrAction_ThrowError Then _
ThrowScriptErrorNoAbort "An error occurred while accessing WMI property: '" & sPropName & "'.", Err
If (ErrAction And ErrAction_Abort) = ErrAction_Abort Then _
Quit()
WMIGetProperty = ""
End If
If (ErrAction And ErrAction_Trace) = ErrAction_Trace Then _
WScript.Echo " + " & sPropName & " :: '" & WMIGetProperty & "'"
End Function
Function WMIExecQuery(ByVal sNamespace, ByVal sQuery)
'
' WMIExecQuery :: Executes the WMI query and returns the result set.
'
'
Dim oWMI, oQuery, nInstanceCount
Dim e
Set e = New Error
On Error Resume Next
Set oWMI = GetObject(sNamespace)
e.Save
On Error GoTo 0
If IsEmpty(oWMI) Then
ThrowScriptErrorNoAbort "Unable to open WMI Namespace '" & sNamespace & "'. Check to see if the WMI service is enabled and running, and ensure this WMI namespace exists.", e
ThrowEmptyDiscoveryData
End If
On Error Resume Next
Set oQuery = oWMI.ExecQuery(sQuery)
e.Save
On Error GoTo 0
If IsEmpty(oQuery) Or e.Number <> 0 Then
ThrowScriptError "The Query '" & sQuery & "' returned an invalid result set. Please check to see if this is a valid WMI Query.", e
End If
'Determine if we queried a valid WMI class - Count will return 0 or empty
On Error Resume Next
nInstanceCount = oQuery.Count
e.Save
On Error GoTo 0
If e.Number <> 0 Then
ThrowScriptError "The Query '" & sQuery & "' did not return any valid instances. Please check to see if this is a valid WMI Query.", e
End If
Set WMIExecQuery = oQuery
End Function
Function GetFirstItemFromWMIQuery(ByRef oQuery)
ON ERROR RESUME NEXT
Err.Clear
Dim oResult
Set oResult = oQuery.ItemIndex(0)
if Err.number <> 0 then
Err.Clear
Dim oObject
For Each oObject in oQuery
Set oResult = oObject
Exit For
Next
end if
Set GetFirstItemFromWMIQuery = oResult
End Function
'#Include File:ConnectionString.vbs
Function BuildConnectionString(strServer, strDatabase)
ON ERROR RESUME NEXT
Err.Clear
Dim dataSource
dataSource = BuildServerName(strServer, "")
BuildConnectionString = "Data Source=" & EscapeConnStringValue(dataSource) & ";Initial Catalog=" & EscapeConnStringValue(strDatabase) & ";Integrated Security=SSPI"
End Function
Function BuildConnectionStringWithPort(ByVal strServer, ByVal strDatabase, ByVal tcpPort)
ON ERROR RESUME NEXT
Err.Clear
Dim dataSource
dataSource = strServer
If ((tcpPort <> "0") And (tcpPort <> "")) Then
dataSource = dataSource & "," & tcpPort
End If
BuildConnectionStringWithPort = "Data Source=" & EscapeConnStringValue(dataSource) & ";Initial Catalog=" & EscapeConnStringValue(strDatabase) & ";Integrated Security=SSPI"
End Function
' This function should be used to escape Connection String keywords.
Function EscapeConnStringValue (ByVal strValue)
ON ERROR RESUME NEXT
Err.Clear
EscapeConnStringValue = """" + Replace(strValue, """", """""") + """"
End Function
Function EscapeWQLString (ByVal strValue)
ON ERROR RESUME NEXT
Err.Clear
EscapeWQLString = Replace(strValue, "'", "\'")
End Function
Function GetTcpPort (ByVal strServer)
ON ERROR RESUME NEXT
Err.Clear
Dim tcpPort
tcpPort = ""
Call BuildServerName(strServer, tcpPort)
GetTcpPort = tcpPort
End Function
Function BuildServerName(ByVal strServer, ByRef tcp)
ON ERROR RESUME NEXT
Err.Clear
Dim pathArray, instanceName, computerName, ip, serverName
Dim oWMI, oQuery
ip= ""
pathArray = Split(strServer, "\")
computerName = pathArray(0)
instanceName = "MSSQLSERVER"
if (pathArray.Count > 1) Then
instanceName = pathArray(1)
End If
serverName = strServer
Set oWMI = GetObject("winmgmts:\\" & computerName & "\root\Microsoft\SqlServer\ComputerManagement12")
Set oQuery = oWMI.ExecQuery("SELECT * FROM ServerNetworkProtocolProperty WHERE ProtocolName = 'Tcp' AND InstanceName = '"& EscapeWQLString(instanceName) &"' AND PropertyName = 'ListenOnAllIPs'")
If oQuery.Count >0 Then
Dim isListenAll
Set isListenAll = GetFirstItemFromWMIQuery(oQuery)
If(isListenAll.PropertyNumVal = 1) Then
Set oQuery = oWMI.ExecQuery("SELECT * FROM ServerNetworkProtocolProperty WHERE ProtocolName = 'Tcp' AND InstanceName = '"& EscapeWQLString(instanceName) &"' AND IPAddressName = 'IPAll' AND (PropertyName = 'TcpPort' OR PropertyName = 'TcpDynamicPorts') AND PropertyStrVal <> ''")
If (oQuery.Count > 0) Then
tcp = GetFirstItemFromWMIQuery(oQuery).PropertyStrVal
If ((tcp <> "0") And (tcp <> "")) Then
serverName = serverName & "," & tcp
Else tcp = ""
End If
End If
Else
Set oQuery = oWMI.ExecQuery("SELECT * FROM ServerNetworkProtocolProperty WHERE ProtocolName = 'Tcp' AND InstanceName = '"& EscapeWQLString(instanceName) &"' AND IPAddressName <> '' AND PropertyName = 'Enabled' AND PropertyNumVal = 1")
If (oQuery.Count > 0) Then
Dim ipAddressName
ipAddressName = GetFirstItemFromWMIQuery(oQuery).IPAddressName
Set oQuery = oWMI.ExecQuery("SELECT * FROM ServerNetworkProtocolProperty WHERE ProtocolName = 'Tcp' AND InstanceName = '"& EscapeWQLString(instanceName) &"' AND IPAddressName = '"& EscapeWQLString(ipAddressName) &"' AND (PropertyName = 'TcpPort' OR PropertyName = 'TcpDynamicPorts') AND PropertyStrVal <> ''")
If (oQuery.Count > 0) Then
tcp = GetFirstItemFromWMIQuery(oQuery).PropertyStrVal
End If
Set oQuery = oWMI.ExecQuery("SELECT * FROM ServerNetworkProtocolProperty WHERE ProtocolName = 'Tcp' AND InstanceName = '"& EscapeWQLString(instanceName) &"' AND IPAddressName = '"& EscapeWQLString(ipAddressName) &"' AND PropertyName = 'IpAddress' AND PropertyStrVal <> ''")
If (oQuery.Count > 0) Then
ip = GetFirstItemFromWMIQuery(oQuery).PropertyStrVal
End If
If ip <> "" Then
serverName = ip
End If
If ((tcp <> "0") And (tcp <> "")) Then
serverName = servername & "," & tcp
Else tcp = ""
End If
End If
End If
End If
On Error Goto 0
BuildServerName = serverName
End Function
Public Function IsValidDestination(dbConnection, serverName, instanceName, isADODB)
Dim destinationTestQuery
destinationTestQuery = "select SERVERPROPERTY('MachineName') as ServerName, @@servicename as InstanceName"
if 0 = Err.number then
Dim queryResult
if isADODB then
Set queryResult = dbConnection.ExecuteQuery(destinationTestQuery)
else
Set queryResult = dbConnection.Execute(destinationTestQuery)
end if
if Not queryResult.EOF then
Dim queryServerName : queryServerName = UCase(queryResult("ServerName").Value)
Dim queryInstanceName : queryInstanceName = UCase(queryResult("InstanceName").Value)
Dim serverNameWithoutDomain : serverNameWithoutDomain = serverName
Dim dotPosition : dotPosition = InStr(1, serverName, ".")
if Not IsNull(dotPosition) And (dotPosition > 0) then
serverNameWithoutDomain = Left(serverName, dotPosition - 1)
end if
if (UCase(serverNameWithoutDomain) = queryServerName) And (UCase(instanceName) = queryInstanceName) then
IsValidDestination = true
Exit Function
end if
end if
end if
IsValidDestination = false
End Function
'NOTE: This will NOT work without SQLADODB.vbs /DKalinin/
'RETURNS:
Public Function SmartConnect(cnADOConnection, connectionStr, tcp, serverName, instanceName, databaseName)
ON ERROR RESUME NEXT
'try to use SQL server browser
Dim strProv : strProv = BuildConnectionStringWithPort(connectionStr, databaseName, "")
Err.Clear
Dim res : res = cnADOConnection.Open(strProv, "sqloledb", 10)
'use original tcp port and try to connect again
if (0 <> Err.number) Or (Not IsValidDestination(cnADOConnection, serverName, instanceName, true)) then
strProv = BuildConnectionStringWithPort(connectionStr, databaseName, tcp)
Err.Clear
res = cnADOConnection.Open(strProv, "sqloledb", 10)
'get fresh tcp port and try to connect again
if (0 <> Err.number) Or (Not IsValidDestination(cnADOConnection, serverName, instanceName, true)) then
Err.Clear
strProv = BuildConnectionString(connectionStr, databaseName)
res = cnADOConnection.Open(strProv, "sqloledb", 30)
if (0 <> Err.number) Or (Not IsValidDestination(cnADOConnection, serverName, instanceName, true)) then
cnADOConnection.HandleOpenConnectionErrorContinue databaseName, serverName, instanceName
SmartConnect = False
Exit Function
end if
end if
end if
SmartConnect = res
End Function
'NOTE: This WILL work without SQLADODB.vbs /DKalinin/
Public Function SmartConnectWithoutSQLADODB(connectionStr, tcp, serverName, instanceName, databaseName)
ON ERROR RESUME NEXT
Dim cnADOConnection
Set cnADOConnection = MomCreateObject("ADODB.Connection")
cnADOConnection.Provider = "sqloledb"
cnADOConnection.ConnectionTimeout = 30
'try to use SQL server browser
Dim strProv : strProv = BuildConnectionStringWithPort(connectionStr, databaseName, "")
Err.Clear
cnADOConnection.Open strProv
'use original tcp port and try to connect again
if (0 <> Err.number) Or (Not IsValidDestination(cnADOConnection, serverName, instanceName, false)) then
Err.Clear
strProv = BuildConnectionStringWithPort(connectionStr, databaseName, tcp)
cnADOConnection.Open strProv
'get fresh tcp port and try to connect again
if (0 <> Err.number) Or (Not IsValidDestination(cnADOConnection, serverName, instanceName, false)) then
Err.Clear
strProv = BuildConnectionString(connectionStr, databaseName)
cnADOConnection.Open strProv
if (0 <> Err.number) Or (Not IsValidDestination(cnADOConnection, serverName, instanceName, false)) then
cnADOConnection.HandleOpenConnectionErrorContinue databaseName, serverName, instanceName
Set SmartConnectWithoutSQLADODB = Nothing
Exit Function
end if
end if
end if
Set SmartConnectWithoutSQLADODB = cnADOConnection
End Function
For i = 0 to Ubound(aReserved)
If vEncDec = "enc" Then
vString = Replace(vString,aReserved(i,0),aReserved(i,1))
End If
If vEncDec = "dec" Then
vString = Replace(vString,aReserved(i,1),aReserved(i,0))
End If
Next
furlEncode = vString
End Function'#Include File:SQLBlockingSPIDsMonitoring.vbs
dim ERROR_EVENT
' MOM.ScriptAPI takes 3rd parameter as severity of the event
ERROR_EVENT = 1
Dim MAXINT_4
MAXINT_4 = 2147483647
'Start of Main
'-----------------------------------------------------------------------------------------------
call Main()
Sub Main()
Dim objParameters, sConnectionString, sTcpPort
Dim oAPI, oBag
Dim iTime
Dim sInstanceName, sComputerName
Set objParameters = WScript.Arguments
If objParameters.Count <> 5 Then
Quit()
End If
If CDbl(iTime) < 0 Or CDbl(iTime) > (MAXINT_4 / (1000 * 60)) Then
WriteToEventLogAndExit("Invalid WaitMinutes parameter in BlockingSPIDsProvider. Aborting.")
End If
Set objParameters = Nothing
Set oAPI = MOMCreateObject("MOM.ScriptAPI")
Set oBag = oAPI.CreatePropertyBag()
If CheckBlockedSPIDS(oBag, sConnectionString, iTime,sInstanceName, sComputerName, sTcpPort) = 0 Then
Call oAPI.Return(oBag)
Else
Quit()
End If
End Sub
'End of Main
'-----------------------------------------------------------------------------------------------
Sub WriteToEventLogAndExit(ByVal message)
Dim oAPITemp
Set oAPITemp = CreateObject("MOM.ScriptAPI")
oAPITemp.LogScriptEvent WScript.ScriptName, 4201, ERROR_EVENT, message
WScript.Quit()
End Sub
Function EscapeWQLString (ByVal strValue)
ON ERROR RESUME NEXT
Err.Clear
EscapeWQLString = Replace(strValue, "'", "\'")
End Function
Function IsServiceRunning(sqlInstanceName)
Dim oWMI, oQuery, res
res = false
On Error Resume Next
Set oWMI = GetObject("winmgmts://./root/Microsoft/SqlServer/" & SQL_WMI_NAMESPACE)
Set oQuery = oWMI.ExecQuery("select state from SqlService WHERE (ServiceName = '"& EscapeWQLString(sqlInstanceName) &"' OR ServiceName = 'MSSQL$" & EscapeWQLString(sqlInstanceName) &"') and SQLServiceType ='1'")
If oQuery.Count > 0 Then
Dim sqlServiceObject
For Each sqlServiceObject In oQuery
If sqlServiceObject.State = 4 Then
res = true
Exit For
End If
Next
End If
On Error Goto 0
IsServiceRunning = res
End Function
Function PushCellToTable(table, name, rsBlockedSPIDS)
dim value
If IsNull(rsBlockedSPIDS(name).Value) Then
value = "NULL"
Else
value = rsBlockedSPIDS(name).Value
End If
table = table & "<" & name & "><![CDATA" & "[" & value & "]" & "]></" & name & ">"
PushCellToTable = table
End Function
Function CheckBlockedSPIDS(ByRef oBag, ByVal sConnectionString, ByVal iWaitInMinutes, ByRef sInstanceName, ByRef sComputerName, ByVal sTcpPort)
dim cnADOConnection
dim rsBlockedSPIDS
dim sName
dim bFail
dim SCRIPT_SQL
dim SPIDList
dim SPIDCount
dim blokedSPID_TableRow
SCRIPT_SQL = "SET NOCOUNT ON " & vbCrLf & _
"DECLARE @wait_threshold INT " & vbCrLf & _
"SET @wait_threshold = 1000 * 60 * ? " & vbCrLf & _
"DECLARE @servermajorversion INT " & vbCrLf & _
"SET @servermajorversion = REPLACE (LEFT (CONVERT (varchar, SERVERPROPERTY ('ProductVersion')), 2), '.', '') " & vbCrLf & _
" " & vbCrLf & _
"IF OBJECT_ID ('tempdb.dbo.#tmp_blockers') IS NOT NULL DROP TABLE #tmp_blockers " & vbCrLf & _
"IF OBJECT_ID ('tempdb.dbo.#tmp_head_blockers') IS NOT NULL DROP TABLE #tmp_head_blockers " & vbCrLf & _
"IF OBJECT_ID ('tempdb.dbo.#tmp_head_blocker_depth') IS NOT NULL DROP TABLE #tmp_head_blocker_depth " & vbCrLf & _
" " & vbCrLf & _
" " & vbCrLf & _
"SELECT " & vbCrLf & _
" S.session_id, " & vbCrLf & _
" CASE " & vbCrLf & _
" WHEN R.blocking_session_id IS NULL OR R.blocking_session_id = 0 THEN 'TRUE' " & vbCrLf & _
" ELSE 'FALSE' " & vbCrLf & _
" END AS head_blocker, " & vbCrLf & _
" R.blocking_session_id, " & vbCrLf & _
" R.status AS request_status, " & vbCrLf & _
" S.status AS session_status, " & vbCrLf & _
" CASE R.sql_handle " & vbCrLf & _
" WHEN NULL THEN " & vbCrLf & _
" (SELECT text FROM sys.dm_exec_sql_text(R.sql_handle)) " & vbCrLf & _
" ELSE " & vbCrLf & _
" (SELECT text FROM sys.dm_exec_sql_text(C.most_recent_sql_handle)) " & vbCrLf & _
" END AS sql_stmnt, " & vbCrLf & _
" S.program_name, " & vbCrLf & _
" S.host_name, " & vbCrLf & _
" S.host_process_id, " & vbCrLf & _
" S.is_user_process, " & vbCrLf & _
" S.login_name, " & vbCrLf & _
" S.login_time, " & vbCrLf & _
" R.start_time AS request_start_time, " & vbCrLf & _
" R.wait_type, " & vbCrLf & _
" R.last_wait_type, " & vbCrLf & _
" CONVERT(NUMERIC(9,3),(R.wait_time / 1000.0)) AS wait_time_in_sec, " & vbCrLf & _
" R.command, " & vbCrLf & _
" R.wait_resource, " & vbCrLf & _
" CASE COALESCE(R.transaction_isolation_level, S.transaction_isolation_level) " & vbCrLf & _
" WHEN 0 THEN '0-Unspecified' " & vbCrLf & _
" WHEN 1 THEN '1-ReadUncomitted' " & vbCrLf & _
" WHEN 2 THEN '2-ReadCommitted' " & vbCrLf & _
" WHEN 3 THEN '3-Repeatable' " & vbCrLf & _
" WHEN 4 THEN '4-Serializable' " & vbCrLf & _
" WHEN 5 THEN '5-Snapshot' " & vbCrLf & _
" ELSE CONVERT(VARCHAR(10), COALESCE(R.transaction_isolation_level, S.transaction_isolation_level)) + '-Unknown' " & vbCrLf & _
" END AS transaction_isolation_level, " & vbCrLf & _
" --SQLBUD #487091 " & vbCrLf & _
" CASE " & vbCrLf & _
" WHEN R.open_transaction_count IS NULL THEN (SELECT open_tran FROM sys.sysprocesses AS SP WHERE SP.spid = S.session_id) " & vbCrLf & _
" ELSE R.open_transaction_count " & vbCrLf & _
" END AS open_transaction_count, " & vbCrLf & _
" R.open_resultset_count, " & vbCrLf & _
" CONVERT (decimal(5,2), R.percent_complete) AS percent_complete, " & vbCrLf & _
" R.estimated_completion_time, " & vbCrLf & _
" --SQLBUD #438189 (fixed in SP2) " & vbCrLf & _
" CASE WHEN (@servermajorversion > 9) OR (@servermajorversion = 9 AND SERVERPROPERTY ('ProductLevel') >= 'SP2' COLLATE Latin1_General_BIN) " & vbCrLf & _
" THEN R.logical_reads ELSE R.logical_reads - S.logical_reads END AS request_logical_reads, " & vbCrLf & _
" CASE WHEN (@servermajorversion > 9) OR (@servermajorversion = 9 AND SERVERPROPERTY ('ProductLevel') >= 'SP2' COLLATE Latin1_General_BIN) " & vbCrLf & _
" THEN R.reads ELSE R.reads - S.reads END AS request_reads, " & vbCrLf & _
" CASE WHEN (@servermajorversion > 9) OR (@servermajorversion = 9 AND SERVERPROPERTY ('ProductLevel') >= 'SP2' COLLATE Latin1_General_BIN) " & vbCrLf & _
" THEN R.writes ELSE R.writes - S.writes END AS request_writes, " & vbCrLf & _
" R.cpu_time AS request_cpu_time, " & vbCrLf & _
" R.lock_timeout, " & vbCrLf & _
" R.deadlock_priority, " & vbCrLf & _
" R.row_count AS request_row_count, " & vbCrLf & _
" R.prev_error AS request_prev_error, " & vbCrLf & _
" R.nest_level, " & vbCrLf & _
" R.granted_query_memory, " & vbCrLf & _
" R.user_id, " & vbCrLf & _
" R.transaction_id, " & vbCrLf & _
" S.cpu_time AS session_cpu_time, " & vbCrLf & _
" S.memory_usage, " & vbCrLf & _
" S.reads AS session_reads, " & vbCrLf & _
" S.logical_reads AS session_logical_reads, " & vbCrLf & _
" S.writes AS session_writes, " & vbCrLf & _
" S.prev_error AS session_prev_error, " & vbCrLf & _
" S.row_count AS session_row_count " & vbCrLf & _
"INTO " & vbCrLf & _
" #tmp_blockers " & vbCrLf & _
"FROM " & vbCrLf & _
" (sys.dm_exec_sessions AS S " & vbCrLf & _
" LEFT OUTER JOIN sys.dm_exec_requests AS R ON R.session_id = S.session_id) " & vbCrLf & _
" LEFT OUTER JOIN sys.dm_exec_connections AS C ON C.session_id = S. session_id " & vbCrLf & _
"WHERE " & vbCrLf & _
" ( --Active Request " & vbCrLf & _
" R.session_id IS NOT NULL AND " & vbCrLf & _
" R.blocking_session_id != 0 AND " & vbCrLf & _
" S.session_id != @@SPID AND " & vbCrLf & _
" R.wait_time > @wait_threshold AND " & vbCrLf & _
" (S.is_user_process = 1 OR R.status COLLATE Latin1_General_BIN NOT IN ('background', 'sleeping'))) " & vbCrLf & _
" OR --Head Blocker " & vbCrLf & _
" (S.session_id IN " & vbCrLf & _
" (SELECT S.session_id " & vbCrLf & _
" FROM sys.dm_exec_sessions AS S " & vbCrLf & _
" INNER JOIN sys.dm_exec_requests AS BER ON BER.blocking_session_id = S.session_id " & vbCrLf & _
" LEFT OUTER JOIN sys.dm_exec_requests AS ER ON ER.session_id = S.session_id " & vbCrLf & _
" WHERE " & vbCrLf & _
" (ER.blocking_session_id = 0 OR ER.blocking_session_id IS NULL) " & vbCrLf & _
" AND BER.wait_time > @wait_threshold)); " & vbCrLf & _
" " & vbCrLf & _
"--Find Blocking Levels " & vbCrLf & _
";WITH blocking_levels(session_id, blocking_session_id, blocking_level, head_blocker) AS " & vbCrLf & _
"( " & vbCrLf & _
" SELECT session_id, blocking_session_id, 0 AS blocking_level, session_id AS head_blocker " & vbCrLf & _
" FROM #tmp_blockers " & vbCrLf & _
" WHERE blocking_session_id IS NULL OR blocking_session_id = 0 " & vbCrLf & _
" UNION ALL " & vbCrLf & _
" SELECT TB.session_id, TB.blocking_session_id, BL.blocking_level + 1 AS blocking_level, BL.head_blocker " & vbCrLf & _
" FROM #tmp_blockers AS TB " & vbCrLf & _
" INNER JOIN blocking_levels AS BL " & vbCrLf & _
" ON TB.blocking_session_id = BL.session_id " & vbCrLf & _
") " & vbCrLf & _
"SELECT * " & vbCrLf & _
"INTO #tmp_head_blockers " & vbCrLf & _
"FROM blocking_levels " & vbCrLf & _
" " & vbCrLf & _
"SELECT COUNT(*) - 1 AS head_blocking_depth, head_blocker " & vbCrLf & _
"INTO #tmp_head_blocker_depth " & vbCrLf & _
"FROM #tmp_head_blockers " & vbCrLf & _
"GROUP BY head_blocker " & vbCrLf & _
" " & vbCrLf & _
"-- This query could be collapsed into the query above. It is broken out here to avoid an excessively " & vbCrLf & _
"-- large memory grant due to poor cardinality estimates (no stats on many DMVs). " & vbCrLf & _
" " & vbCrLf & _
"SELECT TOP 20 " & vbCrLf & _
" TB.session_id, " & vbCrLf & _
" TB.blocking_session_id, " & vbCrLf & _
" THB.blocking_level, " & vbCrLf & _
" TB.head_blocker, " & vbCrLf & _
" THBD.head_blocking_depth, " & vbCrLf & _
" TB.request_status, " & vbCrLf & _
" TB.session_status, " & vbCrLf & _
" TB.sql_stmnt, " & vbCrLf & _
" TB.request_start_time, " & vbCrLf & _
" TB.wait_type, " & vbCrLf & _
" TB.last_wait_type, " & vbCrLf & _
" TB.wait_time_in_sec, " & vbCrLf & _
" TB.command, " & vbCrLf & _
" TB.program_name, " & vbCrLf & _
" TB.host_name, " & vbCrLf & _
" TB.host_process_id, " & vbCrLf & _
" TB.is_user_process, " & vbCrLf & _
" TB.login_name, " & vbCrLf & _
" TB.login_time, " & vbCrLf & _
" TB.wait_resource, " & vbCrLf & _
" TB.transaction_isolation_level, " & vbCrLf & _
" TB.open_transaction_count, " & vbCrLf & _
" TB.open_resultset_count, " & vbCrLf & _
" COALESCE(AT.name, AT2.name) AS transaction_name, " & vbCrLf & _
" COALESCE(AT.transaction_begin_time, AT2.transaction_begin_time) AS transaction_begin_time, " & vbCrLf & _
" CASE COALESCE(AT.transaction_type, AT2.transaction_type) " & vbCrLf & _
" WHEN 1 THEN '1-Read/write transaction' " & vbCrLf & _
" WHEN 2 THEN '2-Read-only transaction' " & vbCrLf & _
" WHEN 3 THEN '3-System transaction' " & vbCrLf & _
" WHEN 4 THEN '4-Distributed transaction' " & vbCrLf & _
" ELSE CONVERT(VARCHAR(10), COALESCE(AT.transaction_type, AT2.transaction_type)) + '-Unknown' " & vbCrLf & _
" END AS transaction_type, " & vbCrLf & _
" CASE COALESCE(AT.transaction_state, AT2.transaction_state) " & vbCrLf & _
" WHEN 0 THEN '0-The transaction has not been completely initialized yet.' " & vbCrLf & _
" WHEN 1 THEN '1-The transaction has been initialized but has not started.' " & vbCrLf & _
" WHEN 2 THEN '2-The transaction is active.' " & vbCrLf & _
" WHEN 3 THEN '3-The transaction has ended. This is used for read-only transactions.' " & vbCrLf & _
" WHEN 4 THEN '4-The commit process has been initiated on the distributed transaction. This is for distributed transactions only. The distributed transaction is still active but further processing cannot take place.' " & vbCrLf & _
" WHEN 5 THEN '5-The transaction is in a prepared state and waiting resolution.' " & vbCrLf & _
" WHEN 6 THEN '6-The transaction has been committed.' " & vbCrLf & _
" WHEN 7 THEN '7-The transaction is being rolled back.' " & vbCrLf & _
" WHEN 8 THEN '8-The transaction has been rolled back.' " & vbCrLf & _
" ELSE CONVERT(VARCHAR(10), COALESCE(AT.transaction_state, AT2.transaction_state)) + '-Unknown' " & vbCrLf & _
" END AS transaction_state, " & vbCrLf & _
" TB.percent_complete, " & vbCrLf & _
" TB.estimated_completion_time, " & vbCrLf & _
" TB.request_logical_reads, " & vbCrLf & _
" TB.request_reads, " & vbCrLf & _
" TB.request_writes, " & vbCrLf & _
" TB.request_cpu_time, " & vbCrLf & _
" TB.lock_timeout, " & vbCrLf & _
" TB.deadlock_priority, " & vbCrLf & _
" TB.request_row_count, " & vbCrLf & _
" TB.request_prev_error, " & vbCrLf & _
" TB.nest_level, " & vbCrLf & _
" TB.granted_query_memory, " & vbCrLf & _
" TB.user_id, " & vbCrLf & _
" TB.transaction_id, " & vbCrLf & _
" TB.session_cpu_time, " & vbCrLf & _
" TB.memory_usage, " & vbCrLf & _
" TB.session_reads, " & vbCrLf & _
" TB.session_logical_reads, " & vbCrLf & _
" TB.session_writes, " & vbCrLf & _
" TB.session_prev_error, " & vbCrLf & _
" TB.session_row_count " & vbCrLf & _
"FROM " & vbCrLf & _
" #tmp_blockers AS TB " & vbCrLf & _
" LEFT OUTER JOIN sys.dm_tran_active_transactions AS AT ON AT.transaction_id = TB.transaction_id " & vbCrLf & _
" LEFT OUTER JOIN sys.dm_tran_session_transactions AS TS ON TS.session_id = TB.session_id " & vbCrLf & _
" LEFT OUTER JOIN sys.dm_tran_active_transactions AS AT2 ON AT2.transaction_id = TS.transaction_id " & vbCrLf & _
" LEFT OUTER JOIN #tmp_head_blockers AS THB ON THB.session_id = TB.session_id " & vbCrLf & _
" LEFT OUTER JOIN #tmp_head_blocker_depth AS THBD ON THBD.head_blocker = TB.session_id " & vbCrLf & _
" " & vbCrLf & _
"ORDER BY TB.head_blocker DESC, THB.blocking_level"
On Error resume next
Set cnADOConnection = SmartConnectWithoutSQLADODB(sConnectionString, sTcpPort, sComputerName, sInstanceName, "master")
if cnADOConnection Is Nothing Then
If (((Err.number and 65535) = 16389) or ((Err.number and 65535) = 3661)) And IsServiceRunning(sInstanceName) then ' Login failed or SQL Server does not exist or access denied.
ThrowScriptError "Cannot login to database [" & sComputerName & "][" & sInstanceName & ":master] ", Err
End If
Exit Function
End If
Err.Clear
Dim Cmd
Set Cmd = CreateObject("ADODB.Command")
' Specify the connection
Cmd.ActiveConnection = cnADOConnection
' Specify command type and text
Cmd.CommandText = SCRIPT_SQL
Cmd.CommandType = 1 ' adCmdText
AddParam Cmd, iWaitInMinutes
Set rsBlockedSPIDS = Cmd.Execute
if 0 <> Err.number then
Exit Function
end if
SPIDList = ""
SPIDCount = 0
blokedSPID_TableRow = "<?xml version=""1.0"" encoding=""utf-8""?><BlockedSPIDTable>"
do
bFail = True
Err.Clear
if rsBlockedSPIDS.EOF then
if 0 <> Err.number then Exit Do
bFail = False
Exit Do
end if
if 0 <> Err.number then Exit Do
' We don't want to show Head Blockers in list of blocked
If rsBlockedSPIDS("head_blocker").Value = "FALSE" Then
SPIDCount = SPIDCount + 1
if SPIDList = "" Then
SPIDList = CStr(rsBlockedSPIDS("session_id").Value)
else
SPIDList = SPIDList & "," & CStr(rsBlockedSPIDS("session_id").Value)
end if
End If
Err.Clear
rsBlockedSPIDS.MoveNext
if 0 <> Err.number then Exit Do
Loop
blokedSPID_TableRow = blokedSPID_TableRow & "</BlockedSPIDTable>"
Home
ENU 
Show References: