Keskustelu: Ohjelmointikysymykset: VB6: Prosessin sulkeminen

Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Const WM_QUIT = &H12
Private running As Boolean
Private Const PROCESS_TERMINATE = &H1

Private Sub Command1_Click()
running = True
Command2.Enabled = True
Command1.Enabled = False
End Sub

Private Sub Command2_Click()
running = False
Command1.Enabled = True
Command2.Enabled = False
End Sub

Private Sub Form_Load()
Timer1.Interval = 10
running = False
End Sub

Private Sub Timer1_Timer()
If running = True Then
    Dim turhahwnd As Long, pid As Long, ph As Long
    ' etsitään hwnd, huomaa vbNullString (0 ei toimi tässä)
    turhahwnd = FindWindow(vbNullString, "wuauclt.exe")
    ' hankitaan pid
    GetWindowThreadProcessId turhahwnd, pid
    ' prosessin kahva
    ph = OpenProcess(PROCESS_TERMINATE, 0, pid)
    ' terminoidaan prosessi
    turhahwnd = TerminateProcess(ph, 0)
End If
End Sub

 Declare Function OpenProcess Lib "kernel32.dll" (ByVal dwDesiredAccess As Long, _
ByVal blnheritHandle As Long, ByVal dwAppProcessId As Long) As Long

Declare Function ProcessFirst Lib "kernel32.dll" Alias "Process32First" (ByVal hSnapshot As Long, _
uProcess As PROCESSENTRY32) As Long

Declare Function ProcessNext Lib "kernel32.dll" Alias "Process32Next" (ByVal hSnapshot As Long, _
uProcess As PROCESSENTRY32) As Long

Declare Function CreateToolhelpSnapshot Lib "kernel32.dll" Alias "CreateToolhelp32Snapshot" ( _
ByVal lFlags As Long, lProcessID As Long) As Long

Declare Function TerminateProcess Lib "kernel32.dll" (ByVal ApphProcess As Long, _
ByVal uExitCode As Long) As Long

Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long
Const PROCESS_ALL_ACCESS = 4095
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 * 260
End Type
 Public Sub KillProcess(NameProcess As String)

Const TH32CS_SNAPPROCESS As Long = 2&
Dim uProcess  As PROCESSENTRY32
Dim RProcessFound As Long
Dim hSnapshot As Long
Dim SzExename As String
Dim ExitCode As Long
Dim MyProcess As Long
Dim AppKill As Boolean
Dim AppCount As Integer
Dim i As Integer
Dim WinDirEnv As String

       If NameProcess <> "" Then
          AppCount = 0

          uProcess.dwSize = Len(uProcess)
          hSnapshot = CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, 0&)
          RProcessFound = ProcessFirst(hSnapshot, uProcess)

          Do
            i = InStr(1, uProcess.szexeFile, Chr(0))
            SzExename = LCase$(Left$(uProcess.szexeFile, i - 1))
            WinDirEnv = Environ("Windir") + "\"
            WinDirEnv = LCase$(WinDirEnv)

            If Right$(SzExename, Len(NameProcess)) = LCase$(NameProcess) Then
               AppCount = AppCount + 1
               MyProcess = OpenProcess(PROCESS_ALL_ACCESS, False, uProcess.th32ProcessID)
               AppKill = TerminateProcess(MyProcess, ExitCode)
               Call CloseHandle(MyProcess)
            End If
            RProcessFound = ProcessNext(hSnapshot, uProcess)
          Loop While RProcessFound
          Call CloseHandle(hSnapshot)
       End If

End Sub

Private running As Boolean

'-------------------------------------------------------


Private Sub Command1_Click()
running = True
Command2.Enabled = True
Command1.Enabled = False
End Sub

Private Sub Command2_Click()
running = False
Command1.Enabled = True
Command2.Enabled = False
End Sub

Private Sub Form_Load()
Timer1.Interval = 10
running = False
End Sub

Private Sub Timer1_Timer()
If running = True Then
    'Dim turhahwnd As Long, pid As Long, ph As Long
    ' etsitään hwnd, huomaa vbNullString (0 ei toimi tässä)
    'turhahwnd = FindWindow(vbNullString, "wuauclt.exe")
    ' hankitaan pid
    'GetWindowThreadProcessId turhahwnd, pid
    ' prosessin kahva
    'ph = OpenProcess(PROCESS_TERMINATE, 0, pid)
    ' terminoidaan prosessi
    'turhahwnd = TerminateProcess(ph, 0)
    'PostMessage turhahwnd, WM_QUIT, 0, 0
    KillProcess "wuauclt.exe"
End If
End Sub