Hallo Leute,
ich möchte mit meinem Programm ein externes Programm schließn lassen das sich aufgehangen hat.
mit dieser Routine klappt es das Programm zu schließen wenn es noch normal läuft:
1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: 26: 27: 28: 29: 30: 31: 32: 33: 34: 35: 36: 37: 38: 39: 40: 41: 42: 43: 44: 45: 46: 47: 48: 49: 50: 51: 52: 53: 54: 55: 56: 57:
| function GetProcessID(sProcName: String): Integer; var hProcSnap: THandle; pe32: TProcessEntry32; begin result := -1; hProcSnap := CreateToolHelp32SnapShot(TH32CS_SNAPPROCESS, 0); if hProcSnap = INVALID_HANDLE_VALUE then exit;
pe32.dwSize := SizeOf(ProcessEntry32);
if Process32First(hProcSnap, pe32) = true then while Process32Next(hProcSnap, pe32) = true do begin if pos(sProcName, pe32.szExeFile) <> 0then result := pe32.th32ProcessID; end; CloseHandle(hProcSnap); end;
function killprozess2(programm: string): integer; var erg: integer; error_log: TStringList; begin result := 0;
if GetProcessID(programm) > 0 then begin SendMessage(GetWindowFromID(GetProcessID(programm)), WM_QUIT, 0, 0); sleep(5000); end;
while(True) do begin Application.ProcessMessages; if GetProcessID(programm) > 0 then begin erg := KillProcess(GetProcessID(programm)); if erg = 1 then begin end; if erg >= 2 then begin error_log := TStringList.Create; error_log.LoadFromFile('error_log.txt'); error_log.Add( FormatDateTime('dd.mm.yyyy, hh:nn:ss', now) + ' '+programm + ' konnte nicht beendet werden!! Anwendung wurde geschlossen!'); error_log.SaveToFile('error_log.txt'); Application.Terminate; break; end; end else begin result := 1; break; end; end; end; |
Aber wenn das Programm bereits fest hängt dann hängt auch mein Programm beim ersten SendMessage.
Bekommt man das anders hin, dass das Programm auf jeden Fall beendet wird?