Ukoncenie neodpovedajuceho procesu – Visual Basic – Fórum – Programujte.com

ahojte, mam vytvoreny maximalne jednoduchy program vo VB.NET,

        For Each proc As Process In System.Diagnostics.Process.GetProcesses
            If proc.ProcessName = "test" Then
                If proc.Responding = False Then
                    ' attempt to kill the process
                    proc.Kill()
                End If
            End If
        Next

no ja by som to potreboval aj za cenu zlozitosti prerobit do VB6, google sa snazi, ale nedal mi zatial nic co by mi pomohlo vyriesit tento problem

EDIT: ospravedlnujem sa zabudol som napisat co od toho vlastne ocakavam :D potrebujem kontrolovat jeden program a v pripade jeho zamrznutia ho ukoncit

Muj google něco našel. Jde to buď s API, nebo s pomocí Microsoft Scripting Reference. Scripting jsem nezkoušel.

API dává na výběr dvě možnosti: Unload nebo Terminate. "Unload" funguje, jen když process není zamrzlej a de facto spouští queryunload event toho processu, takže se může objevit dialog, "Chcete uložit změny v souboru?" :-) nebo tak něco, podle kódu té procedury, který může mimo jiné celý Unload zrušit (Cancel = True). Terminate je okamžitý odstřel třeba i zamrzlého procesu.

Obě metody získávají ProcessID skrz jméno processu, což není přesně ExeName. Chce to vyzkoušet, většinou je to ExeName bez ".exe". 

Code:

Private Declare Function IsWindow Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function SendMessageTimeout Lib "user32" Alias "SendMessageTimeoutA" (ByVal hWnd As Long, ByVal msg As Long, ByVal wParam As Long, lParam As Any, ByVal fuFlags As Long, ByVal uTimeout As Long, lpdwResult As Long) As Long

Const WM_NULL As Long = &H0
Const WM_CLOSE = &H10
'Const SMTO_NORMAL As Long = &H0
'Const SMTO_BLOCK As Long = &H1
Const SMTO_ABORTIFHUNG As Long = &H2
Const ERROR_TIMEOUT As Long = &H5B4

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32.dll" (ByVal hWnd As Long, lpdwProcessId As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAcess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Const SYNCHRONIZE = &H100000
Const PROCESS_TERMINATE As Long = &H1

Dim Process_hWnd As Long
Dim Process_ID As Long
Dim Process_Handle As Long

Public Function ProcessResponding(ByVal hWnd As Long, Optional ByVal Timeout As Long = 100) As Boolean

    Dim nRet As Long
    Dim nResult As Long

    If IsWindow(hWnd) Then
        nRet = SendMessageTimeout(hWnd, WM_NULL, 0&, 0&, SMTO_ABORTIFHUNG, Timeout, nResult)
        IsResponding = (nRet <> 0)
    End If

End Function

Private Sub Unload_Process(ProgramName As String)

    Process_hWnd = FindWindow(vbNullString, ProgramTitle)

    If Process_hWnd = 0 Then
        MsgBox "Error finding process window handle"
        Exit Sub
    End If

    If Not ProcessResponding(Process_hWnd) Then
        MsgBox "Process is not responding and cannot be unloaded"
        Exit Sub
    End If

    PostMessage Process_hWnd, WM_CLOSE, 0&, 0&
    MsgBox "Process successfully unloaded"

End Sub

Private Sub Terminate_Process_If_Hung(ProgramName As String)

    Process_hWnd = FindWindow(vbNullString, ProgramTitle)
    If Process_hWnd = 0 Then
        MsgBox "Error finding process window handle"
        Exit Sub
    End If

    If ProcessResponding(Process_hWnd) Then
        MsgBox "Process is responding"
        Exit Sub
    End If

    GetWindowThreadProcessId Process_hWnd, Process_ID
    If Process_ID = 0 Then
        MsgBox "Error finding process ID"
        Exit Sub
    End If

    Process_Handle = OpenProcess(SYNCHRONIZE Or PROCESS_TERMINATE, ByVal 0&, Process_ID)
    If Process_ID = 0 Then
        MsgBox "Error finding process object handle"
        Exit Sub
    End If

    If TerminateProcess(Process_Handle, 0&) = 0 Then
        MsgBox "Error terminating process"
    Else
        MsgBox "Process successfully terminated"
    End If

    CloseHandle Process_Handle

End Sub

Pardon, nějak se mi tam podařilo dostat tři chybky.

Namísto IsResponding má být ProcessResponding

a ProgramTitle zaměň za ProgramName 2x.

Tak to dopadá, když se přejmenovává na poslední chvíli lol

dakujem, ale nakoniec som sa rozhodol pouzit .net riesenie ako samotny program ktory bezi na pozadi...

no program spusta kontrolu cez timer kazdych 5 sekund a pomaly si kradne pamat, tuto pamat by som potreboval nejako uvolnovat nech nezozerie po par hodinach vsetku... viete mi niekto poradit ako na to?

#4 ing
vyriesil som to takto

        For Each proc As Process In System.Diagnostics.Process.GetProcesses
            If proc.ProcessName = "test" Then
                If proc.Responding = False Then
                    ' attempt to kill the process
                    proc.Kill()
                End If
            End If
        Next
        GC.Collect()

pamat vobec nenarasta, drzi sa na slusnej hodnote, len neviem ci je to spravne riesenie

Různé problémy mají různá řešení    Ale mě ten VB Code vyhovuje. Líbí se mi, že narozdíl od Windows Task Manageru odstřelí línou aplikaci okamžitě, bez ohledu na to jak je zaplněná RAM. Co potřebuje doladit je optimální kontrola odezvy. Občas stačí, aby se vložilo CD do mechaniky nebo právě končilo stahování většího souboru a na malou chvíli pak zamrzne všechno. Tomu bych se rád vyhnul kontrolami v kratších intervalech a sčítáním sérií bez odezvy.

Teď zkouším testovat tohle nastavení: Interval kontroly - 1000 ms. Čekání na odezvu - 100 ms. Série bez odezvy pro ukončení programu - 10x. Vytížení procesu programem, i když cíl neodpovídá, je krásných 0%.

Plus je tam ještě pár dalších oříšků. Některé programy neodpovídají hned po svém spuštění, protože se dlouho načítají, nebo jak zjistit ten správný ProgramName? Asi vylistováním všech běžících programů s pomocí API EnumWindows. Program bych nechal běžet v system tray, jenom by se občas zobrazila bublina s časem do ukončení aplikace, která už pár kontrol neodpovídá, s možností zrušit ukončení.

Vymyšlený to mám, fungovat to musí, už to jenom nacvakat.   Osobně mě nejvíc štve Opera, která ignoruje nastavení a pravidelně si bere 90 % paměti a v podstatě znemožní spustit cokoliv jiného.

#6 pee-jay_cz

*Vytížení procesoru 0 %. Vytížení RAM 1 - 3 MB.

ja toto potrebujem k jednemu programu, ktory rad zamrza ked ma otvorit dwg vykres, tak kontrolujem ci je zamrznuty a ked je zamrznuty dlhsie ako minutu tak ho ukoncim, lebo viem ze to uz nenacita...

#8 ing
Já nevím, co je dwg. Děláš tam něco s prioritou procesu? Myslím prioritu tvýho hlídače, aby při monitoringu odezvy sám nezamrzal. Občas mám pocit, že se to děje...

dwg je CAD (autocad) výkres... u mňa sa jedná o naozaj jednoduchý program, ktorý kontroluje dva programy a keď jeden z nich neodpovedá, tak upozorní užívateľa, program ukončí a spraví záznam do jednoduchej access tabuľky... ešte nemám odkontrolované či náhodou môj program nezamrzne, dnes som ho mal spustený pár hodín a sem tam som mu spustil jednoduchý program ktorý sa zámerne zacyklí aby neodpovedal a jediný problém som mal s tým že si ten môj program naberal pamäť, ale google mi upresnil ako funguje garbage collection a tým som mu v tom zabránil, respektíve som to naberanie pamäte extrémne spomalil, ešte ma ale čaká študovanie :D