请教：如何判断 进程死掉？？（分不够再加）

Question

我想写个监控程序，如果程序死掉，系统报警。
程序在系统中的进程有什么名称吗？例如：我运行project1.exe 系统中的线程名称也是project1吗？

Answer 1

procedure Tgetcol.FormClick(Sender: TObject);
var t : tcolor;
r,g,b : byte;
begin
t := canvas.pixels[tx,ty];
r := getRvalue(t);
g := getGvalue(t);
B := getBvalue(t);
LABEL2.COLOR := T;
LABEL1.CAPTION := '$00' + HEXB(R) + HEXB(G) + HEXB(B);
end;
一个完整的例子，运行后在屏幕下方有个小条子，然后鼠标点击屏幕上任意点，
小条子上将用16进制显示颜色值：
unit Ugetcor;interfaceuses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, ExtCtrls, Buttons;type
  Tgetcol = class(TForm)
    Panel1: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    procedure FormClick(Sender: TObject);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Panel1Click(Sender: TObject);
    procedure FormDblClick(Sender: TObject);
    procedure FormResize(Sender: TObject);
  private
    tx,ty : integer;
    procedure WMEraseBkng(var MSg:TWMEraseBkgnd);message WM_ERASEBKGND;
  public
    { Public declarations }
  end;var
  getcol: Tgetcol;
implementation{$R *.DFM}
const
  Digits : array[0..$F] of Char = '0123456789ABCDEF';function HexB(B : Byte) : string;
  {-Return hex string for byte}
begin
  HexB[0] := #2;
  HexB[1] := Digits[B shr 4];
  HexB[2] := Digits[B and $F];
end;procedure Tgetcol.WMEraseBkng(var MSg:TWMEraseBkgnd);
begin
     Msg.Result:=1;
end;procedure Tgetcol.FormClick(Sender: TObject);
var t : tcolor;
r,g,b : byte;
begin
t := canvas.pixels[tx,ty];
r := getRvalue(t);
g := getGvalue(t);
B := getBvalue(t);
LABEL2.COLOR := T;
LABEL1.CAPTION := '$00' + HEXB(R) + HEXB(G) + HEXB(B);
end;procedure Tgetcol.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
tx := x;
ty := y;
end;procedure Tgetcol.Panel1Click(Sender: TObject);
begin
CLOSE;
end;procedure Tgetcol.FormDblClick(Sender: TObject);
begin
close;
end;procedure Tgetcol.FormResize(Sender: TObject);
begin
panel1.top := height - panel1.height -1;
panel1.left := width - panel1.width -1;
panel1.visible := true;
end;end.

Answer 2

以前的帖子，希望有帮助：
如何在delphi中查找Windows系统中没有响应的进程及杀死这些没有响应的进程?
  
查杀进程（NT/2000适用）：unit Unit1;interfaceuses
　Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
　ComCtrls, ExtCtrls, StdCtrls, tlhelp32;type
　TForm1 = class(TForm)
　　Button1: TButton;
　　ListView1: TListView;
　　Button2: TButton;
　　procedure Button1Click(Sender: TObject);
　　procedure Button2Click(Sender: TObject);
　　procedure FormCreate(Sender: TObject);
　private
　　{ Private declarations }
　public
　　{ Public declarations }
　end;var
　Form1: TForm1;implementation{$R *.DFM}procedure TForm1.Button1Click(Sender: TObject);
var
　Han: THandle;
　Process: PROCESSENTRY32;
　ok: boolean;
　Rec: TListItem;
　i: integer;
begin
　ListView1.Items.Clear;
　i := 0;
　Han := CreateToolhelp32Snapshot(TH32CS_SNAPALL, 0);
　Process.dwSize := SizeOf(Process);
　ok := Process32First(Han, Process);
　while ok do
　begin
　　Rec := ListView1.Items.Add;
　　Rec.Caption := Process.szExeFile;
　　Rec.SubItems.Add(IntToStr(Process.th32ProcessID));
　　i := i + 1;
　　ok := Process32Next(Han, Process);
　end;end;procedure TForm1.Button2Click(Sender: TObject);
var
　Han: THandle;
　ProcessID: int64;
　ExitCode: DWORD;
　i: integer;
begin
　for i := 0 to ListView1.Items.Count - 1 do
　　if listview1.Items[i].Selected then
　　begin
　　　ProcessID := StrToInt64(ListView1.Selected.SubItems.Strings[0]);
　　　Han := OpenProcess(PROCESS_TERMINATE, true, ProcessID);
　　　GetExitCodeProcess(Han, ExitCode);
　　　TerminateProcess(Han, ExitCode);
　　end;
　Sleep(100);
　Button1.Click;
end;procedure TForm1.FormCreate(Sender: TObject);
begin
　Button1Click(sender);
end;end.都是kill进程的方法，那么楼主问的，如何判断一个程序没有响应了呢？
procedure KillProgram(Classname : string; WindowTitle : string); 
const 
PROCESS_TERMINATE = $0001; 
var 
ProcessHandle : THandle; 
ProcessID: Integer; 
TheWindow : HWND; 
begin 
TheWindow := FindWindow(Classname, WindowTitle); 
GetWindowThreadProcessID(TheWindow, @ProcessID); 
ProcessHandle := OpenProcess(PROCESS_TERMINATE, FALSE, ProcessId); 
TerminateProcess(ProcessHandle,4); 
end;
uses TlHelp32;procedure EndProcess(AExeName: string);
var
  lppe: TProcessEntry32;
  found : boolean;
  Hand : THandle;
begin
  Hand := CreateToolhelp32Snapshot(TH32CS_SNAPALL,0);
  found := Process32First(Hand,lppe);
  while found do
  begin
    if UpperCase(StrPas(lppe.szExeFile)) = UpperCase(AExeName) then
    begin
      TerminateProcess(OpenProcess(PROCESS_TERMINATE, true,
        lppe.th32ProcessID), 0);
      Exit;
    end
    else
      found := Process32Next(Hand,lppe);
  end;
end;AExeName为要中止的进程的名字
有一个UNDOCUMENTED函数,乃是其他的解决方案,NT和9X有个USER32.DLL的函数,IsHungAppWindow(NT)和IsHungThread(9X).使用起来简便无比.下面给出原型.
BOOL IsHungAppWindow (
         HWND hWnd, // handle to main app's window
);BOOL IsHungThread (
 DWORD dwThreadId, // The thread's identifier of the main app's window
);有了原型,连解释都不需要,好得不的了.:)不过调用时需要GetProcAddress.库里没有该函数.

Answer 3

#define APP_NAME "MyApp"
void __fastcall TMainForm::CreateParams(Controls::TCreateParams &Params)
{
    TForm::CreateParams(Params);
    strcpy(Params.WinClassName, APP_NAME);
} HWND HwndPre = ::FindWindow(APP_NAME, NULL);
 if(HwndPre!=NULL)
 {
     //程序已经退出了
 }

Answer 4

应该调用SendMessageTimeOut函数看窗口是否超时：//EnumWindows: (a teljesseg igenye nelkul)
function EnumWindowsProc (Wnd: HWND; lb: TListbox): BOOL; stdcall;
begin
if IsWindowVisible(Wnd) and
((GetWindowLong(Wnd, GWL_HWNDPARENT) = 0) or
(HWND(GetWindowLong(Wnd, GWL_HWNDPARENT)) = GetDesktopWindow)) and
((GetWindowLong(Wnd, GWL_EXSTYLE) and WS_EX_TOOLWINDOW) = 0) then
begin
SendMessageTimeout(Wnd, WM_GETTEXT, Sizeof( caption ), DWORD(@caption), SMTO_NORMAL, 50, Res1);
lb.Items.AddObject(caption, TObject(Wnd));
...
tid := GetWindowThreadProcessID(Wnd, @pid);
...
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ListBox2.Clear;
EnumWindows( @EnumWindowsProc, DWORD(ListBox2));
end;//GetWindow: (a teljesseg igenye nelkul)
procedure TaskList(lb: TListbox);
begin
F := GetWindow(Form1.Handle, GW_HWNDFIRST);
L := GetWindow(Form1.Handle, GW_HWNDLAST);
Wnd := F;
repeat
SendMessageTimeout(Wnd, WM_GETTEXT, Sizeof( caption ), DWORD(@caption), SMTO_NORMAL, 50, Res1);
if IsWindowVisible(Wnd) and
((GetWindowLong(Wnd, GWL_HWNDPARENT) = 0) or
(HWND(GetWindowLong(Wnd, GWL_HWNDPARENT)) = GetDesktopWindow)) and
((GetWindowLong(Wnd, GWL_EXSTYLE) and WS_EX_TOOLWINDOW) = 0) then
begin
if not Res2 then caption := '[Timeout]'; if caption = '' then caption := '[no title]';
lb.Items.AddObject(caption, TObject(Wnd));
...
tid := GetWindowThreadProcessID(Wnd, @pid);
...
end;
Wnd := GetWindow(Wnd, GW_HWNDNEXT);
until Wnd = L;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ListBox2.Clear;
TaskList(Listbox2);
end;