程序通过调用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.th32processid<>getcurrentprocessid 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.Handle<>0 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.selected<>nil 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.
