Task Manager

Option Explicit

Private Declare Function GetWindowThreadProcessId Lib “user32″ (ByVal hWnd As Long, lpdwProcessId As Long) As Long

‘ Used to cache owner window handle:
Private Declare Function GetWindowLong Lib “user32″ Alias “GetWindowLongA” (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Const GWL_HWNDPARENT = (-8)

Private tasks As CTaskList
Private m_hWndOwner As Long

‘ Control indices
Private Const cEndTask = 0
Private Const cSwitchTo = 1
Private Const cNewTask = 2

‘ Subitem fields
Private Const iStatus = 1
Private Const iHandle = 2
Private Const iProcess = 3

Private Sub Command1_Click(Index As Integer)
   Dim hWnd As Long
   Dim PID As Long
   Dim ndx As Long
   Const RunCaption = “Create New Task”
  
   ‘ Retrieve hWnd for selected item
   If Not ListView1.SelectedItem Is Nothing Then
      hWnd = CLng(ListView1.SelectedItem.SubItems(2))
   End If
  
   ‘ Act on user request
   Select Case Index
      Case cEndTask
         If hWnd Then
            ‘ Disable this form, and attempt
            ‘ to shutdown requested task.
            Me.Enabled = False
               tasks.Activate hWnd:=hWnd
               tasks.Terminate hWnd:=hWnd, DialogDelay:=3000
            Me.Enabled = True
            Me.SetFocus
         End If
        
      Case cSwitchTo
         If hWnd Then
            tasks.Activate hWnd:=hWnd
            Me.WindowState = vbMinimized
         End If
        
      Case cNewTask
         Call ShowRunDialog1( _
            hWndOwner:=Me.hWnd, _
            Caption:=RunCaption, _
            Description:=”Type the name of a folder, program, Internet resource, or document, and Visual Basic will open it for you.”, _
            hIcon:=Image2.Picture.Handle)
  
         ‘Call ShowRunDialog2( _
            hWndOwner:=Me.hWnd, _
            Caption:=RunCaption, _
            Description:=”Type the name of a folder, program, Internet resource, or document, and Visual Basic will open it for you.”, _
            hIcon:=Image2.Picture.Handle)
  
   End Select
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
      If KeyAscii = vbKeyEscape Then
      Unload Me
   End If
End Sub

Private Sub Form_Load()
   Dim clm As ColumnHeader
   With ImageList1
      .ImageHeight = 16
      .ImageWidth = 16
      .UseMaskColor = False
      .ListImages.Add , “null”, Image1.Picture
   End With
 
   With ListView1
      .View = lvwReport
      Set clm = .ColumnHeaders.Add(, , “Task”)
      Set clm = .ColumnHeaders.Add(, , “Status”, .Width / 5)
      Set clm = .ColumnHeaders.Add(, , “hWnd”)
      Set clm = .ColumnHeaders.Add(, , “ProcessID”)
      .SortOrder = lvwDescending
      Set .SmallIcons = ImageList1
      .HideSelection = False
   End With

   Set tasks = New CTaskList

   tasks.HungTimeout = 250

   Frame1.BackColor = Me.BackColor
   Call ResetButtons(False)

   App.Title = Me.Caption
 
   m_hWndOwner = GetWindowLong(Me.hWnd, GWL_HWNDPARENT)
 
   Call ProcessPrioritySet(hWnd:=Me.hWnd, Priority:=High)

   Me.Show
   With ListView1
      .ColumnHeaders(1).Width = .Width * 0.65
      .ColumnHeaders(2).Width = .Width * 0.25
      .ColumnHeaders(3).Width = .Width * 0.25
      .ColumnHeaders(4).Width = .Width * 0.25
   End With

   Call RefreshTaskList
 
   Set ListView1.SelectedItem = Nothing

   Timer1.Interval = 1000
   Timer1.Enabled = True
End Sub

Private Sub Form_Resize()
   Dim Margin As Long
   Dim BtnWidth As Long
  

   Margin = ListView1.Left
   BtnWidth = Command1(cEndTask).Width
  
   On Error Resume Next
   With TabStrip1
  
      .Move .Left, .Left, Me.ScaleWidth – .Left * 2, Me.ScaleHeight – .Left * 2
      Frame1.Move .ClientLeft, .ClientTop, .ClientWidth, .ClientHeight
   End With
   With Frame1
 
      ListView1.Move Margin, Margin, .Width – Margin * 2, .Height – Margin * 3 – Command1(cEndTask).Height
   
      Command1(cNewTask).Move .Width – BtnWidth – Margin, .Height – Margin – Command1(cNewTask).Height
      Command1(cSwitchTo).Move Command1(cNewTask).Left – BtnWidth – Margin \ 2, Command1(cNewTask).Top
      Command1(cEndTask).Move Command1(cSwitchTo).Left – BtnWidth – Margin \ 2, Command1(cNewTask).Top
   End With
End Sub

Private Sub ListView1_ColumnClick(ByVal ColumnHeader As ComctlLib.ColumnHeader)
   Select Case ColumnHeader.Index
      Case 1
     
         With ListView1
            If .SortOrder = lvwAscending Then
               .SortOrder = lvwDescending
            Else
               .SortOrder = lvwAscending
            End If
            .Sorted = True
            .Sorted = False
         End With
        
      Case 2
     
         Call RefreshTaskList
   End Select
End Sub

Private Sub ListView1_DblClick()
   ‘ Switch to selected task.
   Call Command1_Click(cSwitchTo)
End Sub

Private Sub ListView1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
   Dim itm As ListItem

   With ListView1
      Set itm = .HitTest(x, y)
      If itm Is Nothing Then
         Set .SelectedItem = Nothing
      End If
      Call ResetButtons(Not (.SelectedItem Is Nothing))
   End With
End Sub

Private Sub Timer1_Timer()

   Call RefreshTaskList
End Sub
Private Sub RefreshTaskList()
   Dim i As Long
   Dim key As String
   Dim itm As ListItem
   Dim nStatus As TaskStatus
  
  
   With ListView1.ListItems
      For i = .Count To 1 Step -1
         If tasks.Valid(hWnd:=CLng(.Item(i).SubItems(iHandle))) = False Then
       
            If .Item(i).Selected Then
               Set ListView1.SelectedItem = Nothing
               Call ResetButtons(False)
            End If
            .Remove i
         End If
      Next i
   End With
  
   tasks.Refresh

   For i = 1 To tasks.Count
  
      If tasks.hWnd(i) <> Me.hWnd Then
     
     
         key = “h” & Hex(tasks.hWnd(i))
         On Error Resume Next
            Set itm = ListView1.ListItems.Add(, key, tasks.Caption(i))
            If Err.Number Then
               Set itm = ListView1.ListItems(key)
            End If
         On Error GoTo 0
        
         If itm.SmallIcon = “” Then
          
            On Error Resume Next
            ImageList1.ListImages.Add , key, CreatePicture(tasks.hIconSm(i), vbPicTypeIcon)
            On Error GoTo 0
            itm.SmallIcon = key
           
        
            itm.SubItems(iHandle) = “&” & key
         
            itm.SubItems(iProcess) = CStr(tasks.ProcessID(i))
         End If
        
     
         nStatus = tasks.Status(i)
        
        
         If itm.Text <> tasks.Caption(i) Then
            itm.Text = tasks.Caption(i)
         End If
         If itm.Tag <> CStr(nStatus) Then
            If nStatus = tlStatusOK Then
               itm.SubItems(iStatus) = “Running”
            Else
               itm.SubItems(iStatus) = “Not Responding”
            End If
            itm.Tag = CStr(nStatus)
         End If
      End If
   Next i
End Sub

Private Sub ResetButtons(ByVal Enabled As Boolean)
   Command1(cEndTask).Enabled = Enabled
   Command1(cSwitchTo).Enabled = Enabled
End Sub

About these ads