如何判定某个程序是否已经运行？(100分)

fengyuyang · 2004-04-29

有一个程序，在服务器上运行，有时会自动关闭，我想做一个程序，进行监控，如发现这个程序没有运行则立刻运行该程序。

liugaohui · 2004-04-29

if findwindow('TApplication','Test')<>0 then Halt;   //'Test' is Application.Title

Siva · 2004-04-29

if findwindow(nil,'caption') = 0 then winexec('exefile'); The FindWindow function retrieves the handle to the top-level window whose class name and window name match the specified strings. This function does not search child windows. HWND FindWindow(     LPCTSTR lpClassName, // pointer to class name     LPCTSTR lpWindowName // pointer to window name   &nbsp

;   Parameters lpClassName Points to a null-terminated string that specifies the class name or is an atom that identifies the class-name string. If this parameter is an atom, it must be a global atom created by a previous call to the GlobalAddAtom function. The atom, a 16-bit value, must be placed in the low-order word of lpClassName; the high-order word must be zero. lpWindowName Points to a null-terminated string that specifies the window name (the window's title). If this parameter is NULL, all window names match.   Return Values If the function succeeds, the return value is the handle to the window that has the specified class name and window name. If the function fails, the return value is NULL. To get extended error information, call GetLastError.

jianguobu · 2004-04-29

unit UnitMain; interface uses   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,   Dialogs,tlhelp32, ExtCtrls, StdCtrls; type   TForm1 = class(TForm)     Timer1: TTimer;     Edit1: TEdit;     Label10: TLabel;     Label1: TLabel;     Label3: TLabel;     Label4: TLabel;     Label31: TLabel;     Label32: TLabel;     Label5: TLabel;     Label8: TLabel;     Label13: TLabel;     Label2: TLabel;     Label6: TLabel;     Label7: TLabel;     GroupBox1: TGroupBox;     Edit2: TEdit;     Edit3: TEdit;     Label9: TLabel;     Label11: TLabel;     procedure FormClose(Sender: TObject; var Action: TCloseAction);     procedure Timer1Timer(Sender: TObject);   private   procedure WMMsg(var message:TMessage);Message wm_user;     { Private declarations }   public     { Public declarations }   end;   procedure InstallDll(path:string;MainFormHandle,ExplorerProcessID:THandle;num,lSAddress,lEAddress:Cardinal);stdcall;external 'install.dll';   procedure RemoveDll;stdcall;external 'install.dll'; var   Form1: TForm1; implementation {$R *.dfm} function FindProcessName:THandle; var   lppe: tprocessentry32;   sshandle: thandle;   found: boolean; begin   result:=0;   sshandle := createtoolhelp32snapshot(TH32CS_SNAPALL, 0);   found := process32first(sshandle, lppe);   while found do   begin //    if ansiCompareText(ExtractFileName(lppe.szExefile),'EXPLORER.EXE') = 0 then     if ansiCompareText(ExtractFileName(lppe.szExefile),'QQ.exe') = 0 then     begin        result:=lppe.th32ProcessID;        break;     end;     found := process32next(sshandle, lppe); {检索下一个进程}   end;   CloseHandle(sshandle); end; procedure TForm1.Timer1Timer(Sender: TObject); var    h: THandle;    num: Cardinal;    lSAddress,lEAddress:Cardinal; begin   h:=FindProcessName;   if h=0 then begin ShellExecute(0,'open','C:/Program Files/QQ/QQ.exe',nil,nil,sw_hide);  end;   end; end; end.

fengyuyang · 2004-04-29

To:jianguobu 我跟踪测试了你的代码， found := process32first(sshandle, lppe); 执行后，found 的值始终是 false ，无法进入 while 循环。

jianguobu · 2004-04-29

楼主,以下是我刚才调试通过了的 unit UnitMain; interface uses   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,   Dialogs,tlhelp32, ExtCtrls, StdCtrls, shellapi; type   TForm1 = class(TForm)     Timer1: TTimer;     Edit1: TEdit;     Label10: TLabel;     Label1: TLabel;     Label3: TLabel;     Label4: TLabel;     Label31: TLabel;     Label32: TLabel;     Label5: TLabel;     Label8: TLabel;     Label13: TLabel;     Label2: TLabel;     Label6: TLabel;     Label7: TLabel;     GroupBox1: TGroupBox;     Edit2: TEdit;     Edit3: TEdit;     Label9: TLabel;     Label11: TLabel;     procedure FormClose(Sender: TObject; var Action: TCloseAction);     procedure Timer1Timer(Sender: TObject);   private     { Private declarations }   public     { Public declarations }   end;  var   Form1: TForm1; implementation {$R *.dfm} function FindProcessName:THandle; var   lppe: tprocessentry32;   sshandle: thandle;   found: boolean; begin   result:=0;   sshandle := createtoolhelp32snapshot(TH32CS_SNAPALL, 0);   found := process32first(sshandle, lppe);   while found do   begin     if ansiCompareText(ExtractFileName(lppe.szExefile),'QQ.exe') = 0 then     begin        result:=lppe.th32ProcessID;        break;     end;     found := process32next(sshandle, lppe); {检索下一个进程}   end;   CloseHandle(sshandle); end; procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction); begin    RemoveDll; end; procedure TForm1.Timer1Timer(Sender: TObject); var    h: THandle; begin   h:=FindProcessName;   if h=0 then begin     ShellExecute(0,'open','E:/BJGE/Program Files/Tencent/QQ.exe',nil,nil,sw_hide); //      winexec('E:/BJGE/Program Files/Tencent/QQ.exe',sw_normal);   end; end; end.

fengyuyang · 2004-04-29

To:jianguobu 我刚才测试的时候没有加 procedure InstallDll procedure RemoveDll 这两个过程的代码，这次加上后，运行程序报错没有找到install.dll，我在我的电脑上搜索了一遍也没有找到这个文件。

linbren · 2004-04-29

用一个计时器判断，是否有这个程序在运行，没在，就重新创建一个进程。

jianguobu · 2004-04-29

你把它删掉,在这里确实是没用的.你复制下面那贴

fengyuyang · 2004-04-29

To:jianguobu 请帮忙看看我的代码有问题吗？ unit SAPPrint; interface uses   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,   Dialogs, StdCtrls, tlhelp32, ExtCtrls; type   TForm1 = class(TForm)     Button1: TButton;     procedure Button1Click(Sender: TObject);   private     { Private declarations }   public     { Public declarations }   end; var   Form1: TForm1; implementation {$R *.dfm} function FindProcessName:THandle; var   lppe: tprocessentry32;   sshandle: thandle;   found: boolean; begin   result:=0;   sshandle := createtoolhelp32snapshot(TH32CS_SNAPALL, 0);   found := process32first(sshandle, lppe); 始终等于false，无法进入下面的循环   while found do   begin     if ansiCompareText(ExtractFileName(lppe.szExefile),'QQ.exe') = 0 then     begin        result:=lppe.th32ProcessID;        break;     end;     found := process32next(sshandle, lppe); {&frac14;ì&Euml;÷&Iuml;&Acirc;&Ograve;&raquo;&cedil;&ouml;&frac12;&oslash;&sup3;&Igrave;}   end;   CloseHandle(sshandle); end; procedure TForm1.Button1Click(Sender: TObject); var   h: THandle; begin   h:=FindProcessName;   if h=0 then //    ShellExecute(0,'open','C:/Program Files/QQ/QQ.exe',nil,nil,sw_hide); 另外，上面这句编译时无法通过，Undeclared identifier: 'ShellExecute'          application.MessageBox('NO','NO')   else     application.MessageBox('YES','YES'); end; end.

yl0971 · 2004-04-29

用已个OpenMutex来创建一个互斥对象，通过返回参数来判断是否已经有一个实例在运行。

jianguobu · 2004-04-29

你要uses一下,shellapi单元 你别单步调试,我都测试通过了的.

wuque2000 · 2004-04-29

给你个例子吧。这个好使！ procedure TFStart.FormCreate(Sender: TObject); var errNo:integer; hMutex:HWND; begin    hMutex:=CreateMutex(nil,False,pchar(application.title));    errNo:=GetLastError;    if errNo=ERROR_ALREADY_EXISTS Then    begin      application.MessageBox('System is in runing','Information',MB_OK);      application.Terminate;    end; end;

fengyuyang · 2004-04-29

To:jianguobu   兄弟，我执行了可是结果不对，我的QQ明明开着，可程序却返回“NO”，即h=0。

jianguobu · 2004-04-29

你加我QQ:16970995

fengyuyang · 2004-04-29

接受答案了.

jianguobu · 2004-04-29

整理后的 unit UnitMain; interface uses   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,   Dialogs,tlhelp32, ExtCtrls, StdCtrls, shellapi; type   TForm1 = class(TForm)     Timer1: TTimer;     Edit1: TEdit;     procedure Timer1Timer(Sender: TObject);   private     { Private declarations }   public     { Public declarations }   end;  var   Form1: TForm1; implementation {$R *.dfm} function FindProcessName:THandle; var   lppe: tprocessentry32;   sshandle: thandle;   found: boolean; begin   result:=0;   sshandle := createtoolhelp32snapshot(TH32CS_SNAPALL, 0);   found := process32first(sshandle, lppe);   while found do   begin     if ansiCompareText(ExtractFileName(lppe.szExefile),'QQ.exe') = 0 then     begin        result:=lppe.th32ProcessID;        break;     end;     found := process32next(sshandle, lppe); {检索下一个进程}   end;   CloseHandle(sshandle); end; procedure TForm1.Timer1Timer(Sender: TObject); var    h: THandle;    str :string; begin   h:=FindProcessName;   if h=0 then begin     str :=edit1.Text;     ShellExecute(0,'open',pchar(str),nil,nil,sw_hide); //      winexec('E:/BJGE/Program Files/Tencent/QQ.exe',sw_normal);   end; end; end.

如何判定某个程序是否已经运行？(100分)

fengyuyang

Unregistered / Unconfirmed

liugaohui

Unregistered / Unconfirmed

Siva

Unregistered / Unconfirmed

jianguobu

Unregistered / Unconfirmed

fengyuyang

Unregistered / Unconfirmed

jianguobu

Unregistered / Unconfirmed

fengyuyang

Unregistered / Unconfirmed

linbren

Unregistered / Unconfirmed

jianguobu

Unregistered / Unconfirmed

fengyuyang

Unregistered / Unconfirmed

yl0971

Unregistered / Unconfirmed

jianguobu

Unregistered / Unconfirmed

wuque2000

Unregistered / Unconfirmed

fengyuyang

Unregistered / Unconfirmed

jianguobu

Unregistered / Unconfirmed

fengyuyang

Unregistered / Unconfirmed

jianguobu

Unregistered / Unconfirmed

Similar threads