frmmain.frm

进程管理

            Else
               ListView1.ListItems.Add , , tPE.szexeFile, , "Proc"
               With ListView1.ListItems(ListView1.ListItems.Count)
                  .SubItems(1) = tPE.th32ProcessID
                  .SubItems(2) = tPE.pcPriClassBase
                  .SubItems(3) = tPE.cntThreads
        
                  '.SubItems(5) = tPE.th32DefaultHeapID
                  .SubItems(4) = tPE.th32ParentProcessID
                  '.SubItems(7) = tPE.th32ModuleID
               End With
            End If
            lNextProcess = Process32Next(lSnapShot, tPE)
        Loop
        
        CloseHandle (lSnapShot)
        
    Else
        ListView1.ListItems.Add , , "无法获取进程！！"
    End If

If ListView2.Visible = True Then
  Refresh1
End If
End Sub

Private Sub Form_Load()
On Error Resume Next
AdjustTokenPrivileges2000
ListView1.LabelEdit = lvwManual
EnumProcess
intStoreX = -5
    intStoreY = picGraph.ScaleHeight
picGraph.FillColor = vbGreen
picGraph.ForeColor = vbGreen
picGraph.AutoRedraw = True

    Call Timer1_Timer
    StatusBar1.Panels(1).Text = "就绪"

DoEvents
MyToolbarStyle
DoEvents
Toolbar1.Buttons(5).Enabled = False
On Error Resume Next
SetIcon Me.hWnd, "AAA"

End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Unload frmAbout
If MeUnload = False Then
Cancel = 1
Me.Hide
End If

End Sub

Private Sub Form_Resize()
If Me.WindowState = 1 Then
Me.Hide
Else
Me.Show
End If

End Sub

Private Sub ListView1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then
 Me.PopupMenu EndProcess, 0
End If
End Sub

Private Sub ListView2_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then
txtWindowTitle = ListView2.SelectedItem.Text
Me.PopupMenu WinOptions, 0
End If
End Sub

Private Sub optFast_Click()
Timer1.Interval = 500
End Sub

Private Sub optMedium_Click()
Timer1.Interval = 1500
End Sub

Private Sub optSlow_Click()
Timer1.Interval = 3000
End Sub

Private Sub RefreshCtls_Click()
On Error GoTo errorhandler
GoSub begin

errorhandler:
Exit Sub

begin:
Dim A As Long
A = FindWindow(vbNullString, txtWindowTitle)
If A = 0 Then Exit Sub

EnumerateChildren A, 2
End Sub

Private Sub StopRefresh_Click()
Select Case StopRefresh.Caption
  Case "停止刷新"
    StopRefresh.Caption = "开始刷新"
    StopRefresh1.Caption = "开始刷新"
    Timer2.Enabled = False
    Exit Sub
  Case Else
    StopRefresh.Caption = "停止刷新"
    StopRefresh1.Caption = "停止刷新"
    Timer2.Enabled = True
    Exit Sub
End Select

End Sub

Private Sub StopRefresh1_Click()
Call StopRefresh_Click

End Sub

Private Sub Timer2_Timer()
On Error Resume Next
StatusBar1.Panels(1).Text = "正在刷新进程列表"
DoEvents
EnumProcess
StatusBar1.Panels(1).Text = "就绪"
End Sub

Private Sub Timer1_Timer()
On Error Resume Next

    GlobalMemoryStatus tMemStat

    lblTotalPageFile.Caption = Format(tMemStat.dwTotalPageFile / 1024, "###,##0")
    lblTotalVirtual.Caption = Format(tMemStat.dwTotalVirtual / 1024, "###,##0")
    lblTotPhys.Caption = Format(tMemStat.dwTotalPhys / 1024, "###,##0")

    lblAvailPageFile.Caption = Format(tMemStat.dwAvailPageFile / 1024, "###,##0")
    lblAvailPhys.Caption = Format(tMemStat.dwAvailPhys / 1024, "###,##0")
    lblAvailVirtual.Caption = Format(tMemStat.dwAvailVirtual / 1024, "###,##0")

    lblPercPage.Caption = Format(lblAvailPageFile.Caption / lblTotalPageFile.Caption * 100, "0.00") & "%"
    lblPercVirtual.Caption = Format(lblAvailVirtual.Caption / lblTotalVirtual.Caption * 100, "0.00") & "%"
    lblPercPhysical.Caption = Format(lblAvailPhys.Caption / lblTotPhys.Caption * 100, "0.00") & "%"

    If tMemStat.dwMemoryLoad = 0 Then                                                                       '
        
        picLoad.Height = picBack.Height / 100 / 15 * CInt(100 - (lblAvailPhys.Caption / lblTotPhys.Caption * 100))
        
        picLoad.Top = ((picBack.Height / 15) - picLoad.Height)
        
        lblLoad.Caption = 100 - CInt(lblAvailPhys.Caption / lblTotPhys.Caption * 100) & "%"
    Else
        
        picLoad.Height = picBack.Height / 100 / 15 * tMemStat.dwMemoryLoad
        picLoad.Top = ((picBack.Height / 15) - picLoad.Height)                                              '
        lblLoad.Caption = tMemStat.dwMemoryLoad & "%"
    End If

    StepUpProgress intStoreX, intStoreY, tMemStat.dwMemoryLoad, &HC000&

    DoEvents
End Sub
Sub StepUpProgress(x1 As Integer, y1 As Integer, Percentage As Long, Colour As Long)
On Error Resume Next
Dim tmpBlt As Long
Dim tmpLineTo As Long
Dim tmpMove As Long

    If x1 > picGraph.ScaleWidth Then
        picGraph.Cls
        x1 = 0
        GoTo shiftpic
    Else
shiftpic:

        NewX = x1 + (picGraph.ScaleWidth / 200)
        NewY = picGraph.ScaleHeight - ((Percentage / 100) * picGraph.ScaleHeight)
    End If
    picGraph.Line (x1, y1)-(NewX, NewY)
    

    intStoreX = NewX
    intStoreY = NewY
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As ComctlLib.Button)
On Error Resume Next

 Select Case Button.Index
   Case 1
    Unload Me
   Case 2
    Call Timer2_Timer
    
   Case 3
   With ListView1.SelectedItem
     Dim hProcess As Long, Killer As Long
     Killer = MsgBox("终止某些进程可能导致系统不稳定。" & vbCrLf & "确实需要终止进程" & .Text & "吗？", vbYesNo + 64, "进程监视器")
     If Killer = vbYes Then
     
     hProcess = OpenProcess(PROCESS_TERMINATE, False, .SubItems(1))
     If hProcess Then
     TerminateProcess hProcess, 0
     
     DoEvents
     Pause 1000
     
     Call Timer2_Timer
     Else
     MsgBox "无法终止该进程！(进程可能受保护 或 已经被结束)", 64, "进程监视器"
     End If
     End If
   End With
   Case 4
     
      ListView2.Visible = True
      ListView1.Visible = False
      Toolbar1.Buttons(3).Enabled = False
      Toolbar1.Buttons(4).Enabled = False
      Toolbar1.Buttons(5).Enabled = True
      Refresh1
      
   Case 5
    
      ListView2.Visible = False
      ListView1.Visible = True
      Toolbar1.Buttons(3).Enabled = True
      Toolbar1.Buttons(4).Enabled = True
      Toolbar1.Buttons(5).Enabled = False
      EnumProcess
      
   Case 6
   frmAbout.Show
End Select
End Sub
Public Sub Refresh1()
On Error GoTo errorhandler

GoSub begin
Dim A$, i As Long

errorhandler:
MsgBox "错误！ -- " & Err.Description, vbOKOnly + vbExclamation, "进程监视器"
Exit Sub

begin:
RefreshD = True

ListView2.ListItems.Clear
txtWindowTitle = ""
DoEvents

For i = 1 To 10000
    A$ = GetWindowTitle(i)
    z = FindWindow(vbNullString, A$)
    hW = Form1.hWnd
    If z <> 0 Then
        If A$ <> vbNullString And LCase(A$) <> LCase(APPCap) And LCase(A$) <> "进程监视器" And i <> hW Then
            
            If IsWindowEnabled(z) = 0 Then
                If IsWindowVisible(z) = 0 Then
                    ListView2.ListItems.Add , , "[无效窗口] " + A$, , "Win"
                    ListView2.ListItems(ListView2.ListItems.Count).SubItems(1) = "不可见"
                ElseIf IsWindowVisible(z) = 1 Then
                    ListView2.ListItems.Add , , "[无效窗口] " + A$, , "Win"
                    ListView2.ListItems(ListView2.ListItems.Count).SubItems(1) = "可见"
                    
                End If
            ElseIf IsWindowEnabled(z) = 1 Then
                If IsWindowVisible(z) = 0 Then
                    ListView2.ListItems.Add , , A$, , "Win"
                    ListView2.ListItems(ListView2.ListItems.Count).SubItems(1) = "不可见"
                ElseIf IsWindowVisible(z) = 1 Then
                    ListView2.ListItems.Add , , A$, , "Win"
                    ListView2.ListItems(ListView2.ListItems.Count).SubItems(1) = "可见"
                End If
            End If
             
        End If
        
    End If
Next i

DoEvents

RefreshD = False
End Sub

Private Sub WinClose_Click()
On Error GoTo errorhandler
GoSub begin

errorhandler:
MsgBox "错误！ -- " & Err.Description, vbOKOnly + vbExclamation, "进程监视器"
Exit Sub

begin:
A = FindWindow(vbNullString, txtWindowTitle)
WindowHandle A, 0

Pause 1000

Refresh1
End Sub

Private Sub WinHide_Click()
On Error GoTo errorhandler
GoSub begin

errorhandler:
MsgBox "错误！ -- " & Err.Description, vbOKOnly + vbExclamation, "进程监视器"
Exit Sub

begin:
A = FindWindow(vbNullString, txtWindowTitle)
WindowHandle A, 2

Pause 1000

If DontRemove = True Then Else Refresh1
End Sub

Private Sub WinMax_Click()
On Error GoTo errorhandler
GoSub begin

errorhandler:
MsgBox "错误！ -- " & Err.Description, vbOKOnly + vbExclamation, "进程监视器"
Exit Sub

begin:
A = FindWindow(vbNullString, txtWindowTitle)
WindowHandle A, 3
End Sub

Private Sub WinMin_Click()
On Error GoTo errorhandler
GoSub begin

errorhandler:
MsgBox "错误！ -- " & Err.Description, vbOKOnly + vbExclamation, "进程监视器"
Exit Sub

begin:
A = FindWindow(vbNullString, txtWindowTitle)
WindowHandle A, 4
End Sub

Private Sub WinNor_Click()
On Error GoTo errorhandler
GoSub begin

errorhandler:
MsgBox "错误！ -- " & Err.Description, vbOKOnly + vbExclamation, "进程监视器"
Exit Sub

begin:
A = FindWindow(vbNullString, txtWindowTitle)
WindowHandle A, 5
End Sub

Private Sub WinPassword_Click()
On Error GoTo errorhandler
GoSub begin

errorhandler:
Exit Sub

begin:
Dim A As Long
A = FindWindow(vbNullString, txtWindowTitle)
If A = 0 Then Exit Sub

EnumerateChildren A, 1

End Sub

Private Sub WinRename_Click()
On Error GoTo errorhandler
GoSub begin

errorhandler:
MsgBox "错误！ -- " & Err.Description, vbOKOnly + vbExclamation, "进程监视器"
Exit Sub

begin:
A = FindWindow(vbNullString, txtWindowTitle)
WindowHandle A, 1

Pause 1000

Refresh1
End Sub