332 lines
10 KiB
Plaintext
332 lines
10 KiB
Plaintext
VERSION 5.00
|
|
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "COMCTL32.OCX"
|
|
Begin VB.Form frmMonitor
|
|
Caption = "Trigger Monitor"
|
|
ClientHeight = 3495
|
|
ClientLeft = 60
|
|
ClientTop = 345
|
|
ClientWidth = 5475
|
|
LinkTopic = "Form1"
|
|
ScaleHeight = 3495
|
|
ScaleWidth = 5475
|
|
StartUpPosition = 3 'Windows Default
|
|
Begin VB.TextBox txtThreshold
|
|
Height = 375
|
|
Left = 1920
|
|
TabIndex = 2
|
|
Top = 2400
|
|
Width = 975
|
|
End
|
|
Begin VB.CommandButton cmdBeginMonitor
|
|
Caption = "&Begin Monitor"
|
|
Height = 495
|
|
Left = 4080
|
|
TabIndex = 3
|
|
Top = 2160
|
|
Width = 1215
|
|
End
|
|
Begin VB.TextBox txtMsgCount
|
|
Height = 375
|
|
Left = 1920
|
|
Locked = -1 'True
|
|
TabIndex = 12
|
|
TabStop = 0 'False
|
|
Top = 3000
|
|
Visible = 0 'False
|
|
Width = 975
|
|
End
|
|
Begin VB.TextBox txtPollingFrequency
|
|
Height = 375
|
|
Left = 1920
|
|
TabIndex = 1
|
|
Top = 1800
|
|
Width = 975
|
|
End
|
|
Begin VB.Timer Timer1
|
|
Left = 240
|
|
Top = 720
|
|
End
|
|
Begin VB.CommandButton cmdClose
|
|
Caption = "&Close"
|
|
Height = 495
|
|
Left = 4080
|
|
TabIndex = 4
|
|
Top = 2880
|
|
Width = 1215
|
|
End
|
|
Begin ComctlLib.ProgressBar ProgressBar1
|
|
Height = 375
|
|
Left = 960
|
|
TabIndex = 6
|
|
Top = 1200
|
|
Width = 4335
|
|
_ExtentX = 7646
|
|
_ExtentY = 661
|
|
_Version = 327682
|
|
Appearance = 1
|
|
End
|
|
Begin VB.TextBox txtQueueName
|
|
Height = 375
|
|
Left = 1560
|
|
TabIndex = 0
|
|
Top = 240
|
|
Width = 3735
|
|
End
|
|
Begin VB.Label Label4
|
|
Caption = "Threshold:"
|
|
Height = 255
|
|
Left = 960
|
|
TabIndex = 14
|
|
Top = 2520
|
|
Width = 735
|
|
End
|
|
Begin VB.Label Label5
|
|
Caption = "Message Count:"
|
|
Height = 255
|
|
Left = 600
|
|
TabIndex = 13
|
|
Top = 3120
|
|
Visible = 0 'False
|
|
Width = 1215
|
|
End
|
|
Begin VB.Label Label3
|
|
Caption = "Polling Frequency (sec) :"
|
|
Height = 255
|
|
Left = 120
|
|
TabIndex = 11
|
|
Top = 1920
|
|
Width = 1695
|
|
End
|
|
Begin VB.Label Label2
|
|
Alignment = 1 'Right Justify
|
|
Caption = "Count:"
|
|
Height = 255
|
|
Left = 240
|
|
TabIndex = 10
|
|
Top = 1320
|
|
Width = 495
|
|
End
|
|
Begin VB.Label lblProgressMax
|
|
Caption = "Max"
|
|
Height = 255
|
|
Left = 4920
|
|
TabIndex = 9
|
|
Top = 840
|
|
Visible = 0 'False
|
|
Width = 495
|
|
End
|
|
Begin VB.Label lblThreshold
|
|
Caption = "Threshold"
|
|
Height = 255
|
|
Left = 3720
|
|
TabIndex = 8
|
|
Top = 840
|
|
Visible = 0 'False
|
|
Width = 735
|
|
End
|
|
Begin VB.Label lblProgress0
|
|
Caption = "0"
|
|
Height = 255
|
|
Left = 960
|
|
TabIndex = 7
|
|
Top = 840
|
|
Visible = 0 'False
|
|
Width = 375
|
|
End
|
|
Begin VB.Label Label1
|
|
Alignment = 1 'Right Justify
|
|
Caption = "Queue pathname:"
|
|
Height = 255
|
|
Left = 120
|
|
TabIndex = 5
|
|
Top = 360
|
|
Width = 1335
|
|
End
|
|
End
|
|
Attribute VB_Name = "frmMonitor"
|
|
Attribute VB_GlobalNameSpace = False
|
|
Attribute VB_Creatable = False
|
|
Attribute VB_PredeclaredId = True
|
|
Attribute VB_Exposed = False
|
|
' ------------------------------------------------------------------------
|
|
' Copyright (C) 1999 Microsoft Corporation
|
|
'
|
|
' You have a royalty-free right to use, modify, reproduce and distribute
|
|
' the Sample Application Files (and/or any modified version) in any way
|
|
' you find useful, provided that you agree that Microsoft has no warranty,
|
|
' obligations or liability for any Sample Application Files.
|
|
' ------------------------------------------------------------------------
|
|
|
|
|
|
Public qTargetQueue As New MSMQQueue
|
|
Public qinfoTargetQueue As New MSMQQueueInfo
|
|
'
|
|
' Button serves as both to begin monitoring the queue and to stop.
|
|
'
|
|
Private Sub cmdBeginMonitor_Click()
|
|
If Timer1.Enabled Then
|
|
'
|
|
' Timer was enabled, this means that we were asked to stop monitoring.
|
|
'
|
|
ProgressBar1 = 0
|
|
Timer1.Enabled = False
|
|
lblProgress0.Visible = False
|
|
lblThreshold.Visible = False
|
|
lblProgressMax.Visible = False
|
|
txtMsgCount.Visible = False
|
|
Label5.Visible = False
|
|
txtQueueName.Enabled = True
|
|
txtPollingFrequency.Enabled = True
|
|
txtThreshold.Enabled = True
|
|
cmdBeginMonitor.Caption = "&Begin Monitor"
|
|
Else
|
|
'
|
|
' Begin monitor - do some cosmetic changes in form and enable timer
|
|
'
|
|
If CheckInput() Then
|
|
lblProgress0 = "0"
|
|
lblThreshold = txtThreshold
|
|
lblProgressMax = (1 + txtThreshold) * 3 \ 2
|
|
lblProgressMax.Refresh
|
|
ProgressBar1.Min = 0
|
|
ProgressBar1.Max = (1 + txtThreshold) * 3 \ 2
|
|
Timer1.Interval = txtPollingFrequency * 1000 ' convert to milisec.
|
|
Timer1.Enabled = True
|
|
lblProgress0.Visible = True
|
|
lblThreshold.Visible = True
|
|
lblProgressMax.Visible = True
|
|
txtMsgCount.Visible = True
|
|
Label5.Visible = True
|
|
txtQueueName.Enabled = False
|
|
txtPollingFrequency.Enabled = False
|
|
txtThreshold.Enabled = False
|
|
cmdBeginMonitor.Caption = "&Stop Monitor"
|
|
End If
|
|
End If
|
|
End Sub
|
|
Function CheckInput() As Boolean
|
|
If txtQueueName = "" Then
|
|
a = MsgBox("Please enter queue name.", , "Missing input value")
|
|
CheckInput = False
|
|
Exit Function
|
|
ElseIf Left(txtQueueName, 2) = ".\" Then
|
|
'
|
|
' This means local computer, so convert to local computer name
|
|
'
|
|
txtQueueName = GetLocalComputerName() & Mid(txtQueueName, 2)
|
|
End If
|
|
If txtPollingFrequency = "" Then
|
|
a = MsgBox("Please enter polling frequency.", , "Missing input value")
|
|
CheckInput = False
|
|
Exit Function
|
|
End If
|
|
If txtThreshold = "" Then
|
|
a = MsgBox("Please enter threshold value.", , "Missing input value")
|
|
CheckInput = False
|
|
Exit Function
|
|
End If
|
|
If OpenQueue() = False Then
|
|
CheckInput = False
|
|
Exit Function
|
|
End If
|
|
CheckInput = True
|
|
End Function
|
|
|
|
Function OpenQueue() As Boolean
|
|
Dim dSlashPosition As Integer
|
|
dSlashPosition = InStr(1, txtQueueName, "\")
|
|
If dSlashPosition = 0 Then GoTo ErrHandler
|
|
'verify queue exists
|
|
On Error GoTo ErrHandler
|
|
If Not IsDsEnabled Then 'if local computer is DS disabled
|
|
If InStr(txtQueueName, "\private$\") = 0 Then
|
|
txtQueueName = Left(txtQueueName, dSlashPosition) + _
|
|
"private$" + Mid(txtQueueName, dSlashPosition)
|
|
End If
|
|
End If
|
|
|
|
qinfoTargetQueue.PathName = txtQueueName
|
|
Set qTargetQueue = qinfoTargetQueue.Open(Access:=MQ_PEEK_ACCESS, _
|
|
ShareMode:=MQ_DENY_NONE)
|
|
qTargetQueue.Close
|
|
OpenQueue = True
|
|
Exit Function
|
|
ErrHandler:
|
|
MsgBox txtQueueName & " is an invalid Queue pathname", , "Queue Open Failure"
|
|
OpenQueue = False
|
|
End Function
|
|
|
|
Private Sub cmdClose_Click()
|
|
End
|
|
End Sub
|
|
|
|
Private Sub Form_Load()
|
|
Timer1.Enabled = False
|
|
End Sub
|
|
|
|
Private Sub Timer1_Timer()
|
|
'
|
|
' Timer ticking - check number of messages in queue.
|
|
'
|
|
Dim dwNumMessages As Long
|
|
Dim TriggerMsg As String
|
|
'
|
|
' Call function from PerMain.dll
|
|
'
|
|
dwNumMessages = GetPerfmonInfo(qinfoTargetQueue.PathName)
|
|
If ProgressBar1.Max < dwNumMessages Then
|
|
'
|
|
' max the bar do nothing else (to avoid overflowing the progress bar)
|
|
'
|
|
ProgressBar1 = ProgressBar1.Max
|
|
Else
|
|
ProgressBar1 = dwNumMessages
|
|
End If
|
|
|
|
txtMsgCount = dwNumMessages
|
|
'
|
|
' Notify if number of messages in queue exceeded threshold
|
|
'
|
|
If dwNumMessages > txtThreshold Then
|
|
TriggerMsg = "Trigger: " & txtMsgCount & " messages in queue."
|
|
MsgBox TriggerMsg, vbSystemModal, "Trigger Event"
|
|
End If
|
|
End Sub
|
|
|
|
Private Sub txtPollingFrequency_KeyPress(KeyAscii As Integer)
|
|
KeyAscii = DigitsOnly(KeyAscii)
|
|
End Sub
|
|
|
|
Private Sub txtThreshold_KeyPress(KeyAscii As Integer)
|
|
KeyAscii = DigitsOnly(KeyAscii)
|
|
End Sub
|
|
|
|
Function DigitsOnly(KeyAscii As Integer) As Integer
|
|
If Not KeyAscii = 8 And KeyAscii < Asc("0") Or KeyAscii > Asc("9") Then
|
|
Beep
|
|
DigitsOnly = 0 'cancel the character
|
|
Else
|
|
DigitsOnly = KeyAscii
|
|
End If
|
|
End Function
|
|
'
|
|
'Get local computer name
|
|
'
|
|
Function GetLocalComputerName() As String
|
|
Dim str As String
|
|
Dim res As Boolean
|
|
Dim maxlen As Long
|
|
|
|
maxlen = 512
|
|
str = Space(maxlen)
|
|
res = GetComputerNameA(str, maxlen)
|
|
If res = False Then
|
|
GetLocalComputerName = ""
|
|
Exit Function
|
|
End If
|
|
|
|
GetLocalComputerName = Mid(str, 1, maxlen)
|
|
End Function
|
|
|
|
|