本程序通過調用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: T Object );
procedure btnDetermineClick(Sender: T Object );
procedure lvSysProcClick(Sender: T Object );
procedure FormCreate(Sender: T Object );
procedure AppOnMinimize(Sender:T Object );
procedure FormClose(Sender: T Object ; var Action: TCloseAction);
procedure FormDeactivate(Sender: T Object );
procedure lblEmailClick(Sender: T Object );
procedure FormResize(Sender: T Object );
private
{ Private declarations }
fshandle:thandle;
FormOldHeight,FormOldWidth:Integer;
procedure SysTray OnClick (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: T Object );
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: T Object );
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_IC ONERROR )
else
begin
Selected.Delete;
lvAboutProc.Items.Clear;
lblCountSysProc.caption:=inttostr(lvSysProc.items.count);
lblCountAboutProc.caption:='';
end
end;
end;
end;
end;
procedure TForm1.lvSysProcClick(Sender: T Object );
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: T Object );
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:T Object );
begin
ShowWindow(application.handle,SW_HIDE);
end;
//響應鼠標在系統托盤區圖標上點擊
procedure tform1.SysTray OnClick (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: T Object ; var Action: TCloseAction);
begin
Shell_NotifyIcon(NIM_DELETE,@SysTrayIcon); //取消系統托盤區圖標
RegisterServiceProcess(GetcurrentProcessID,0); //取消系統服務程序的註冊
lvSysProc.SmallImages.Free;
end;
//不活動時自動隱藏
procedure TForm1.FormDeactivate(Sender: T Object );
begin
application.minimize;
end;
procedure TForm1.lblEmailClick(Sender: T Object );
begin
if ShellExecute(Handle,'Open',Pchar('Mailto:[email protected]'),nil,nil,SW_SHOW)<33 then
MessageBox(form1.Handle,'無法啟動電子郵件軟件!','我很遺憾',MB_ICONINFORMATION+MB_OK);
end;
//當窗體大小改變時調整各組件位置
procedure TForm1.FormResize(Sender: T Object );
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:[email protected]與我討論。
後記:
上面的代碼中RegisterServiceProcess()是win 9x才有的未公開的api函數.
在學習masm32後,用masm32重寫並改進了這個程序
有興趣的朋友可以下載最新的版本:
http://www.hcny.gov.cn/netres/download/procview.rar