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