mdlprocess1.bas

支持监控包括传输控制协议和 UDP 的所有的互联网传输协议。同时程序具有实时文件防修改监控功能

    th32ProcessID                                                     As Long
    th32HeapID                                                        As Long
    dwFlags                                                           As Long
End Type
Public Type MODULEENTRY32
    dwSize                                                            As Long
    th32ModuleID                                                      As Long
    th32ProcessID                                                     As Long
    GlblcntUsage                                                      As Long
    ProccntUsage                                                      As Long
    modBaseAddr                                                       As Long
    modBaseSize                                                       As Long
    hModule                                                           As Long
    szModule                                                          As String * 256    'MAX_MODULE_NAME32 + 1
    szExePath                                                         As String * MAX_PATH
End Type
Public Type PROCESSENTRY32
    dwSize                                                            As Long
    cntUsage                                                          As Long
    th32ProcessID                                                     As Long
    th32DefaultHeapID                                                 As Long
    th32ModuleID                                                      As Long
    cntThreads                                                        As Long
    th32ParentProcessID                                               As Long
    pcPriClassBase                                                    As Long
    dwFlags                                                           As Long
    szExeFile                                                         As String * MAX_PATH
End Type
Public Type THREADENTRY32
    dwSize                                                            As Long
    cntUsage                                                          As Long
    th32ThreadID                                                      As Long
    th32OwnerProcessID                                                As Long
    tpBasePri                                                         As Long
    tpDeltaPri                                                        As Long
    dwFlags                                                           As Long
End Type
Public Type POINTAPI
    X                                                                 As Long
    Y                                                                 As Long
End Type
Public Type RECT
    Left                                                              As Long
    Top                                                               As Long
    Right                                                             As Long
    Bottom                                                            As Long
End Type
Public Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Boolean
Public Declare Function FormatMessage Lib "kernel32.dll" Alias "FormatMessageA" (ByVal dwFlags As Long, _
                                                                                 ByRef lpSource As Any, _
                                                                                 ByVal dwMessageId As Long, _
                                                                                 ByVal dwLanguageId As Long, _
                                                                                 ByVal lpBuffer As String, _
                                                                                 ByVal nSize As Long, _
                                                                                 ByRef Arguments As Long) As Long
Public Declare Function lstrlen Lib "kernel32.dll" (ByVal lpString As Any) As Long
Public Declare Function OpenProcess Lib "kernel32.dll" (ByVal dwDesiredAccess As Long, _
                                                        ByVal bInheritHandle As Boolean, _
                                                        ByVal dwProcessId As Long) As Long
Private Declare Function OpenThread Lib "kernel32.dll" (ByVal dwDesiredAccess As Long, _
                                                        ByVal bInheritHandle As Boolean, _
                                                        ByVal dwThreadID As Long) As Long
Private Declare Function ResumeThread Lib "kernel32.dll" (ByVal hThread As Long) As Long
Private Declare Function SuspendThread Lib "kernel32.dll" (ByVal hThread As Long) As Long
Public Declare Function TerminateProcess Lib "kernel32.dll" (ByVal hProcess As Long, _
                                                             ByVal uExitCode As Long) As Boolean
Public Declare Function CreateToolhelp32Snapshot Lib "kernel32.dll" (ByVal dwFlags As Long, _
                                                                     ByVal th32ProcessID As Long) As Long
Public Declare Function Process32First Lib "kernel32.dll" (ByVal hSnapShot As Long, _
                                                           ByRef lppe As PROCESSENTRY32) As Boolean
Public Declare Function Process32Next Lib "kernel32.dll" (ByVal hSnapShot As Long, _
                                                          ByRef lppe As PROCESSENTRY32) As Boolean
Private Declare Function Thread32First Lib "kernel32.dll" (ByVal hSnapShot As Long, _
                                                           ByRef lpte As THREADENTRY32) As Boolean
Private Declare Function Thread32Next Lib "kernel32.dll" (ByVal hSnapShot As Long, _
                                                          ByRef lpte As THREADENTRY32) As Boolean
Public Sub ResumeThreads(P_ID As Long)
'// A little different
Dim lCount As Long
Dim i      As Long
'Dim ItemX As ListItem
    lCount = Thread32_Enum(Thread(), P_ID)
'With ListView
'.ListItems.Clear
    For i = 0 To lCount
        If Thread(i).th32OwnerProcessID = P_ID Then
            Thread_Resume CLng(Thread(i).th32ThreadID)
'Set ItemX = ListView.ListItems.Add(, , Thread(i).th32OwnerProcessID, , 4)
'ItemX.SubItems(1) = Thread(i).th32ThreadID
'ItemX.SubItems(2) = Thread(i).cntUsage
        End If
    Next i
'End With
End Sub
Public Sub SuspendThreads(P_ID As Long)
'// A little different
Dim lCount As Long
Dim i      As Long
'Dim ItemX As ListItem
    lCount = Thread32_Enum(Thread(), P_ID)
'With ListView
'.ListItems.Clear
    For i = 0 To lCount
        If Thread(i).th32OwnerProcessID = P_ID Then
            Thread_Suspend CLng(Thread(i).th32ThreadID)
'Set ItemX = ListView.ListItems.Add(, , Thread(i).th32OwnerProcessID, , 4)
'ItemX.SubItems(1) = Thread(i).th32ThreadID
'ItemX.SubItems(2) = Thread(i).cntUsage
        End If
    Next i
'End With
End Sub
Public Function Thread32_Enum(ByRef Thread() As THREADENTRY32, _
                              ByVal lProcessID As Long) As Long
Dim THREADENTRY32 As THREADENTRY32
Dim hSnapShot     As Long
Dim lThread       As Long
    On Error GoTo VB_Error
'// I'm tired, just ask me...
    ReDim Thread(0)
    hSnapShot = CreateToolhelp32Snapshot(TH32CS_SNAPthread, lProcessID)
': 'If hSnapShot = INVALID_HANDLE_VALUE Then Call Err_Dll(Err.LastDllError, "CreateToolHelp32Snapshoot ::: INVALID_HANDLE_VALUE failed", sLocation, "Thread32_Enum")
    THREADENTRY32.dwSize = Len(THREADENTRY32)
    If Thread32First(hSnapShot, THREADENTRY32) = False Then
        Thread32_Enum = -1
'Call Err_Dll(Err.LastDllError, "Thread32First failed", sLocation, "Thread32_Enum")
'If CloseHandle(hSnapShot) = False Then Call Err_Dll(Err.LastDllError, "CloseHandle failed", sLocation, "Thread32_Enum")
        Exit Function
    Else
        ReDim Thread(lThread)
        Thread(lThread) = THREADENTRY32
    End If
    Do
        If Thread32Next(hSnapShot, THREADENTRY32) = False Then
            Exit Do
        Else
            lThread = lThread + 1
            ReDim Preserve Thread(lThread)
            Thread(lThread) = THREADENTRY32
        End If
        DoEvents
    Loop
'If CloseHandle(hSnapShot) = False Then Call Err_Dll(Err.LastDllError, "CloseHandle failed", sLocation, "Thread32_Enum")   'Call Error_API(Err.LastDllError, sLocation & "\Thread32_Enum", "CloseHandle")
    Thread32_Enum = lThread
Exit Function
VB_Error:
'Err_Vb Err.Number, Err.Description, sLocation, "Thread32_Enum"
    Resume Next
End Function
Public Sub Thread_Resume(T_ID As Long)
Dim hThread       As Long
'Dim lSuspendCount As Long
    On Error GoTo VB_Error
    hThread = OpenThread(THREAD_SUSPEND_RESUME, False, T_ID)
'If hThread = 0 Then 'Err_Dll Err.LastDllError, "OpenThread failed", sLocation, "Suspend_Thread"  'Call Error_API(Err.LastDllError, sLocation & "\cmdSuspend_Click", "OpenThread")
    ResumeThread hThread
': If lSuspendCount = -1 Then Err_Dll Err.LastDllError, "OpenThread failed", sLocation, "Suspend_Thread"
'If CloseHandle(hThread) = False Then Err_Dll Err.LastDllError, "CloseThread failed", sLocation, "Suspend_Thread"
Exit Sub
VB_Error:
'Err_Vb Err.Number, Err.Description, sLocation, "Thread_Resume"
    Resume Next
End Sub
Public Sub Thread_Suspend(T_ID As Long)
Dim hThread       As Long
'Dim lSuspendCount As Long
    On Error GoTo VB_Error
    hThread = OpenThread(THREAD_SUSPEND_RESUME, False, T_ID)
'If hThread = 0 Then Err_Dll Err.LastDllError, "OpenThread failed", sLocation, "Suspend_Thread"  'Call Error_API(Err.LastDllError, sLocation & "\cmdSuspend_Click", "OpenThread")
    SuspendThread hThread
': If lSuspendCount = -1 Then Err_Dll Err.LastDllError, "Suspend failed", sLocation, "Suspend_Thread"
'If CloseHandle(hThread) = False Then Err_Dll Err.LastDllError, "CloseThread failed", sLocation, "Suspend_Thread"
Exit Sub
VB_Error:
'Err_Vb Err.Number, Err.Description, sLocation, "Thread_Suspend"
    Resume Next
End Sub