这是我做的一个东东，是用来监测我们系统中的一个主应用程序的：
你在工程文件开始加入 application.ShowMainForm:=false;
这样就能让它成为一个名义上的后台程序啦/
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,shellapi, ExtCtrls, StdCtrls, ScktComp;
type
TProcessInfo=Record //取得系统运行的进程列表
ExeFile:String;
ProcessId
WORD;
end;
ProcessInfo=^TProcessInfo;
TForm1 = class(TForm)
Timer1: TTimer;
ListBox1: TListBox;
Button1: TButton;
Timer2: TTimer;
procedure Timer1Timer(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Timer2Timer(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
buf:string;
Form1: TForm1;
Pro:array[1..10] of string;
implementation
uses TLHelp32, PsApi;
{$R *.dfm}
//读取文件信息
function GetTextFromFile(AFile : String; var ReturnString : string) : boolean;
var
FileStream : TFileStream;
begin
result := false;
if not fileexists(AFile) then exit;
FileStream := TFileStream.Create(AFile,fmOpenRead);
try
if FileStream.Size > 0 then
begin
SetLength(ReturnString,FileStream.Size);
FileStream.Read(ReturnString[1],FileStream.Size);
result := true;
end;
finally
FileStream.Free;
end;
end;
//******************************************************//
// 取进程列表 //
//******************************************************//
function ProcessList():string;
var
ProcessListHandle:THandle;
ProcessStruct:TProcessEntry32;
i,j:Integer;
Proc:array[1..300] of string;
cap,procexe,filepath:string;
p
rocessInfo;
ok:Bool;
Begin
cap:='1';
for i:=1 to 300 do
Proc
:='';
i:=1;
ProcessListHandle:=CreateToolHelp32Snapshot(TH32CS_SNAPPROCESS,0);
ProcessStruct.dwSize:=Sizeof(ProcessStruct);
ok:=Process32First(ProcessListHandle,ProcessStruct);
while Integer(ok)<>0 do Begin
new(p); //每次new一个P （RECORD）会造成内存每次增长4K字节
p.ExeFile:=ProcessStruct.szExeFile;
p.ProcessID:=ProcessStruct.th32ProcessID;
ok:=Process32Next(ProcessListHandle,ProcessStruct);
Proc:=ProcessStruct.szExeFile;//P.ExeFile;
inc(i);
dispose(p);
end;
sleep(100);
for J:=1 to 10 do
begin
procexe:='';
filepath:='';
cap:='1';
procexe:=trim(copy(pro[j],1,pos('=',pro[j])-1));
filepath:=trim(copy(pro[j],pos('=',pro[j])+1,255));
for i:=1 to 300 do
begin
if trim(Proc)=procexe then
cap:='2'
end;
if cap='1' then
begin
try ShellExecute(application.handle,'Open',pchar(filepath),nil,nil,SW_SHOWNORMAL); except end;
with TStringList.Create do
try
LoadFromFile('c:/StartInfobirdLog.txt');
Add(DateTimeToStr(Date+Time)+' _:_ '+'StartInfobird');
SaveToFile('c:/StartInfobirdLog.txt');
finally
Free;
end;
end;
end;
closehandle(ProcessListHandle);
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var
HWnd0: THandle;
Str: PChar;
i:integer;
prol:array[1..1000] of string;
begin
// i:=0;
// try
// HWnd0 := GetWindow(GetDesktopWindow, GW_CHILD);
// repeat
// GetWindowText(HWnd0, Str, 255);
// if Str[0] <> #0 then
// begin
// prol:=Str;
// inc(i)
// end;
// HWnd0 := GetWindow(HWnd0, GW_HWNDNEXT);
// until HWnd0 = 0;
// finally
// end;
// for i:=1 to 1000 do
// begin
// if (pos('Debug',prol)>0) or (pos('Infobird.exe',prol)>0) then
// button1click(nil);
/// end;
// closehandle(HWnd0);
try ProcessList(); except end;
// showmessage('d');
end;
procedure TForm1.FormCreate(Sender: TObject);
var
str,filename:string;
position,j:integer;
Cfilename:string;
FHandle:integer;
begin
j:=1;
filename:='c:/Process.ini';
if GetTextFromFile(filename,Str) then
buf:=str;
begin
Position:=Pos(#$D#$A,buf);
while Position >0 do
begin
Pro[j]:=copy(buf,1,pos(#$D#$A,buf)-1);
buf:=copy(buf,pos(#$D#$A,buf)+2,255);
Position:=Pos(#$D#$A,buf);
inc(j);
end;
end;
Cfilename:='c:/StartInfobirdLog.txt';
try
FHandle:=FileCreate(Cfilename);
finally
FileClose(FHandle);
end;
timer1.Enabled :=true;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
ProcessListHandle:THandle;
h:THandle;
aWORD;
pRocessInfo;
ok:Bool;
ProcessStruct:TProcessEntry32;
Begin
ProcessListHandle:=CreateToolHelp32Snapshot(TH32CS_SNAPPROCESS,0);
ProcessStruct.dwSize:=Sizeof(ProcessStruct);
ok:=Process32First(ProcessListHandle,ProcessStruct);
while Integer(ok)<>0 do Begin
new(p);
p.ExeFile:=ProcessStruct.szExeFile;
p.ProcessID:=ProcessStruct.th32ProcessID;
ok:=Process32Next(ProcessListHandle,ProcessStruct);
if p.ExeFile='Infobird.exe' then begin
h:=openProcess(Process_All_Access,true,p.ProcessId);
GetExitCodeProcess(h,a);
if Integer(TerminateProcess(h,a))<>0 then
try terminateprocess(h,a); except end;
dispose(p);
end;
end;
closehandle(h);
closehandle(ProcessListHandle);
end;
procedure TForm1.Timer2Timer(Sender: TObject);
var
ErrorHandle:THandle;
begin
timer2.Enabled:=false;
ErrorHandle:=FindWindow(nil,'Microsoft Visual C++ Debug Library');
if ErrorHandle<>0 then
begin
SendMessage(ErrorHandle,WM_CLOSE,0,0);
button1click(nil);
application.ProcessMessages;
closehandle(errorhandle);
end;
ErrorHandle:=FindWindow(nil,'Infobird.exe - 应用程序错误');
if ErrorHandle<>0 then
begin
SendMessage(ErrorHandle,WM_CLOSE,0,0);
button1click(nil);
// application.ProcessMessages;
closehandle(ErrorHandle);
end;
timer2.Enabled:=true;
end;
end.
如果你把他做到DLL中也是可以的，只是你要稍微改动点就可以啦。
