用Delphi编写系统进程监控程序

　　　本程序通过调用kernel32.dll中的几个API 函数，搜索并列出系统中除本进程外的所有进程的ID、对应的文件说明符、优先级、CPU占有率、线程数、相关进程信息等有关信息，并可中止所选进程。
　　本程序运行时会在系统托盘区加入图标，不会出现在按Ctrl+Alt+Del出现的任务列表中，也不会在任务栏上显示任务按钮，在不活动或最小化时会自动隐藏。不会重复运行，若程序已经运行，再想运行时只会激活已经运行的程序。
　　本程序避免程序反复运行的方法是比较独特的。因为笔者在试用网上介绍一些方法后，发现程序从最小化状态被激活时，单击窗口最小化按钮时，窗口却不能最小化。于是笔者采用了发送和处理自定义消息的方法。在程序运行时先枚举系统中已有窗口，若发现程序已经运行，就向该程序窗口发送自定义消息，然后结束。已经运行的程序接到自定义消息后显示出窗口。
　　
　　//工程文件procviewpro.dpr
　　program procviewpro;
　　
　　uses
　　Forms, windows, messages, main in 'procview.pas' {Form1};
　　
　　{$R *.RES}
　　{
　　//这是系统自动的
　　begin
　　Application.Initialize;
　　Application.Title :='系统进程监控';
　　Application.CreateForm(TForm1, Form1);
　　Application.Run;
　　end.
　　}
　　
　　var
　　myhwnd:hwnd;
　　
　　begin
　　myhwnd := FindWindow(nil, '系统进程监控'); // 查找窗口
　　if myhwnd=0 then // 没有发现，继续运行
　　begin
　　Application.Initialize;
　　Application.Title :='系统进程监控';
　　Application.CreateForm(TForm1, Form1);
　　Application.Run;
　　end
　　else //发现窗口，发送鼠标单击系统托盘区消息以激活窗口
　　postmessage(myhwnd,WM_SYSTRAYMSG,0,wm_lbuttondown);
　　{
　　//下面的方法的缺点是：若窗口原先为最小化状态，激活后单击窗口最小化按钮将不能最小化窗口
　　showwindow(myhwnd,sw_restore);
　　FlashWindow(MYHWND,TRUE);
　　}
　　end.
　　
　　{
　　//下面是使用全局原子的方法避免程序反复运行
　　const
　　atomstr='procview';
　　
　　var
　　atom:integer;
　　begin
　　if globalfindatom(atomstr)=0 then
　　begin
　　atom:=globaladdatom(atomstr);
　　with application do
　　begin
　　Initialize;
　　Title := '系统进程监控';
　　CreateForm(TForm1, Form1);
　　Run;
　　end;
　　globaldeleteatom(atom);
　　end;
　　end.
　　}
　　
　　
　　//单元文件procview.pas
　　unit procview;
　　
　　interface
　　
　　uses
　　Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
　　StdCtrls, TLHelp32,Buttons, ComCtrls, ExtCtrls,ShellAPI, MyFlag;
　　
　　const
　　PROCESS_TERMINATE=0;
　　SYSTRAY_ID=1;
　　WM_SYSTRAYMSG=WM_USER+100;
　　
　　type
　　TForm1 = class(TForm)
　　lvSysProc: TListView;
　　lblSysProc: TLabel;
　　lblAboutProc: TLabel;
　　lvAboutProc: TListView;
　　lblCountSysProc: TLabel;
　　lblCountAboutProc: TLabel;
　　Panel1: TPanel;
　　btnDetermine: TButton;
　　btnRefresh: TButton;
　　lblOthers: TLabel;
　　lblEmail: TLabel;
　　MyFlag1: TMyFlag;
　　procedure btnRefreshClick(Sender: TObject);
　　procedure btnDetermineClick(Sender: TObject);
　　procedure lvSysProcClick(Sender: TObject);
　　procedure FormCreate(Sender: TObject);
　　procedure AppOnMinimize(Sender:TObject);
　　procedure FormClose(Sender: TObject; var Action: TCloseAction);
　　procedure FormDeactivate(Sender: TObject);
　　procedure lblEmailClick(Sender: TObject);
　　procedure FormResize(Sender: TObject);
　　private
　　{ Private declarations }
　　fshandle:thandle;
　　FormOldHeight,FormOldWidth:Integer;
　　procedure SysTrayOnClick(var message:TMessage);message WM_SYSTRAYMSG;
　　public
　　{ Public declarations }
　　end;
　　
　　var
　　Form1: TForm1;
　　idid: dword;
　　fp32:tprocessentry32;
　　fm32:tmoduleentry32;
　　SysTrayIcon:TNotifyIconData;
　　
　　implementation
　　
　　{$R *.DFM}
　　
　　function RegisterServiceProcess(dwProcessID,dwType:integer):integer;stdcall;external 'KERNEL32.DLL';
　　
　　procedure TForm1.btnRefreshClick(Sender: TObject);
　　var
　　clp:bool;
　　newitem1:Tlistitem;
　　MyIcon:TIcon;
　　
　　IconIndex:word;
　　ProcFile : array[0..MAX_PATH] of char;
　　
　　begin
　　MyIcon:=TIcon.create;
　　lvSysProc.Items.clear;
　　lvSysProc.SmallImages.clear;
　　fshandle:=CreateToolhelp32Snapshot(th32cs_snapprocess,0);
　　fp32.dwsize:=sizeof(fp32);
　　clp:=process32first(fshandle,fp32);
　　IconIndex:=0;
　　while integer(clp)0 do
　　begin
　　if fp32.th32processidgetcurrentprocessid then
　　begin
　　newitem1:=lvSysProc.items.add;
　　{
　　newitem1.caption:=fp32.szexefile;
　　MyIcon.Handle:=ExtractIcon(Form1.Handle,fp32.szexefile,0);
　　}
　　
　　StrCopy(ProcFile,fp32.szExeFile);
　　newitem1.caption:=ProcFile;
　　MyIcon.Handle:=ExtractAssociatedIcon(HINSTANCE,ProcFile,IconIndex);
　　
　　if MyIcon.Handle0 then
　　begin
　　with lvSysProc do
　　begin
　　NewItem1.ImageIndex:=smallimages.addicon(MyIcon);
　　end;
　　end;
　　with newitem1.subitems do
　　begin
　　add(IntToHex(fp32.th32processid,4));
　　Add(IntToHex(fp32.th32ParentProcessID,4));
　　Add(IntToHex(fp32.pcPriClassBase,4));
　　Add(IntToHex(fp32.cntUsage,4));
　　Add(IntToStr(fp32.cntThreads));
　　end;
　　end;
　　clp:=process32next(fshandle,fp32);
　　end;
　　closehandle(fshandle);
　　lblCountSysProc.caption:=IntToStr(lvSysProc.items.count);
　　MyIcon.Free;
　　end;
　　
　　procedure TForm1.btnDetermineClick(Sender: TObject);
　　var
　　processhndle:thandle;
　　begin
　　with lvSysProc do
　　begin
　　if selected=nil then
　　begin
　　messagebox(form1.handle,'请先选择要终止的进程!','操作提示',MB_OK+MB_ICONINFORMATION);
　　end
　　else
　　begin
　　if messagebox(form1.handle,pchar('终止'+itemfocused.caption+'？')
　　,'终止进程',mb_yesno+MB_ICONWARNING+MB_DEFBUTTON2)=mryes then
　　begin
　　idid:=strtoint('$'+itemfocused.subitems[0]);
　　processhndle:=openprocess(PROCESS_TERMINATE,bool(0),idid);
　　if integer(terminateprocess(processhndle,0))=0 then
　　messagebox(form1.handle,pchar('不能终止'+itemfocused.caption+'!')
　　,'操作失败',mb_ok+MB_ICONERROR)
　　else
　　begin
　　Selected.Delete;
　　lvAboutProc.Items.Clear;
　　lblCountSysProc.caption:=inttostr(lvSysProc.items.count);
　　lblCountAboutProc.caption:='';
　　end
　　end;
　　end;
　　end;
　　end;
　　
　　procedure TForm1.lvSysProcClick(Sender: TObject);
　　var
　　newitem2:Tlistitem;
　　clp:bool;
　　begin
　　if lvSysProc.selectednil then
　　begin
　　idid:=strtoint('$'+lvSysProc.itemfocused.subitems[0]);
　　lvAboutProc.items.Clear;
　　fshandle:=CreateToolhelp32Snapshot(th32cs_snapmodule,idid);
　　fm32.dwsize:=sizeof(fm32);
　　clp:=Module32First(fshandle,fm32);
　　while integer(clp)0 do
　　begin
　　newitem2:=lvAboutProc.Items.add;
　　with newitem2 do
　　begin
　　caption:=fm32.szexepath;
　　with newitem2.subitems do
　　begin
　　add(IntToHex(fm32.th32moduleid,4));
　　add(IntToHex(fm32.GlblcntUsage,4));
　　add(IntToHex(fm32.proccntUsage,4));
　　end;
　　end;
　　clp:=Module32Next(fshandle,fm32);
　　end;
　　closehandle(fshandle);
　　lblCountAboutProc.Caption:=IntToStr(lvAboutProc.items.count);
　　end
　　end;
　　
　　procedure TForm1.FormCreate(Sender: TObject);
　　begin
　　with application do
　　begin
　　showwindow(handle,SW_HIDE); //隐藏任务栏上的任务按钮
　　OnMinimize:=AppOnMinimize; //最小化时自动隐藏
　　OnDeactivate:=FormDeactivate; //不活动时自动隐藏
　　OnActivate:=btnRefreshClick;
　　end;
　　RegisterServiceProcess(GetcurrentProcessID,1); //将程序注册为系统服务程序，以避免出现在任务列表中
　　with SysTrayIcon do
　　begin
　　cbSize:=sizeof(SysTrayIcon);
　　wnd:=Handle;
　　uID:=SYSTRAY_ID;
　　uFlags:=NIF_ICON OR NIF_MESSAGE OR NIF_TIP;
　　uCallBackMessage:=WM_SYSTRAYMSG;
　　hIcon:=Application.Icon.Handle;
　　szTip:='系统进程监控';
　　end;
　　Shell_NotifyIcon(NIM_ADD,@SysTrayIcon); //将程序图标加入系统托盘区
　　with lvSysProc do
　　begin
　　SmallImages:=TImageList.CreateSize(16,16);
　　SmallImages.ShareImages:=True;
　　end;
　　FormOldWidth:=self.Width;
　　FormOldHeight:=self.Height;
　　end;
　　
　　//最小化时自动隐藏
　　procedure Tform1.AppOnMinimize(Sender:TObject);
　　begin
　　ShowWindow(application.handle,SW_HIDE);
　　end;
　　
　　//响应鼠标在系统托盘区图标上点击
　　procedure tform1.SysTrayOnClick(var message:TMessage);
　　begin
　　with message do
　　begin
　　if (lparam=wm_lbuttondown) or (lparam=wm_rbuttondown) then
　　begin
　　application.restore;
　　SetForegroundWindow(Handle);
　　showwindow(application.handle,SW_HIDE);
　　end;
　　end;
　　end;
　　
　　procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
　　begin
　　Shell_NotifyIcon(NIM_DELETE,@SysTrayIcon); //取消系统托盘区图标
　　RegisterServiceProcess(GetcurrentProcessID,0); //取消系统服务程序的注册
　　lvSysProc.SmallImages.Free;
　　end;
　　
　　//不活动时自动隐藏
　　procedure TForm1.FormDeactivate(Sender: TObject);
　　begin
　　application.minimize;
　　end;
　　
　　
　　procedure TForm1.lblEmailClick(Sender: TObject);
　　begin
　　if ShellExecute(Handle,'Open',Pchar('Mailto:purpleendurer@163.com'),nil,nil,SW_SHOW)33 then
　　MessageBox(form1.Handle,'无法启动电子邮件软件!','我很遗憾',MB_ICONINFORMATION+MB_OK);
　　end;
　　
　　//当窗体大小改变时调整各组件位置
　　procedure TForm1.FormResize(Sender: TObject);
　　begin
　　with panel1 do top:=top+self.Height-FormOldHeight;
　　with lvSysProc do
　　begin
　　width:=width+self.Width-FormOldWidth;
　　end;
　　
　　with lvAboutProc do
　　begin
　　height:=height+self.Height-FormOldHeight;
　　width:=width+self.Width-FormOldWidth;
　　end;
　　FormOldWidth:=self.Width;
　　FormOldHeight:=self.Height;
　　end;
　　
　　end.
　　
　　以上程序在Delphi 2，Windows 95中文版和Delphi 5,Windows 97中文版中均能正常编译和运行。大家有什么问题请Email to:purpleendurer@163.com与我讨论。
　　
　　后记:
　　上面的代码中RegisterServiceProcess()是win 9x才有的未公开的api函数.
　　
　　在学习masm32后,用masm32重写并改进了这个程序
　　有兴趣的朋友可以下载最新的版本:
　　http://www.hcny.gov.cn/netres/download/procview.rar