本程序通过调用kernel
dll中的几个API 函数
搜索并列出系统中除本进程外的所有进程的ID
对应的文件说明符
优先级
CPU占有率
线程数
相关进程信息等有关信息
并可中止所选进程
本程序运行时会在系统托盘区加入图标不会出现在按Ctrl+Alt+Del出现的任务列表中也不会在任务栏上显示任务按钮在不活动或最小化时会自动隐藏不会重复运行若程序已经运行再想运行时只会激活已经运行的程序
本程序避免程序反复运行的方法是比较独特的因为笔者在试用网上介绍一些方法后发现程序从最小化状态被激活时单击窗口最小化按钮时窗口却不能最小化于是笔者采用了发送和处理自定义消息的方法在程序运行时先枚举系统中已有窗口若发现程序已经运行就向该程序窗口发送自定义消息然后结束已经运行的程序接到自定义消息后显示出窗口
//工程文件procviewprodpr
program procviewpro;
uses
Forms windows messages main in procviewpas {Form};
{$R *RES}
{
//这是系统自动的
begin
ApplicationInitialize;
ApplicationTitle :=系统进程监控;
ApplicationCreateForm(TForm Form);
ApplicationRun;
end
}
var
myhwnd:hwnd;
begin
myhwnd := FindWindow(nil 系统进程监控); // 查找窗口
if myhwnd= then // 没有发现继续运行
begin
ApplicationInitialize;
ApplicationTitle :=系统进程监控;
ApplicationCreateForm(TForm Form);
ApplicationRun;
end
else //发现窗口发送鼠标单击系统托盘区消息以激活窗口
postmessage(myhwndWM_SYSTRAYMSGwm_lbuttondown);
{
//下面的方法的缺点是若窗口原先为最小化状态激活后单击窗口最小化按钮将不能最小化窗口
showwindow(myhwndsw_restore);
FlashWindow(MYHWNDTRUE);
}
end
{
//下面是使用全局原子的方法避免程序反复运行
const
atomstr=procview;
var
atom:integer;
begin
if globalfindatom(atomstr)= then
begin
atom:=globaladdatom(atomstr);
with application do
begin
Initialize;
Title := 系统进程监控;
CreateForm(TForm Form);
Run;
end;
globaldeleteatom(atom);
end;
end
}
//单元文件procviewpas
unit procview;
interface
uses
Windows Messages SysUtils Classes Graphics Controls Forms Dialogs
StdCtrls TLHelpButtons ComCtrls ExtCtrlsShellAPI MyFlag;
const
PROCESS_TERMINATE=;
SYSTRAY_ID=;
WM_SYSTRAYMSG=WM_USER+;
type
TForm = class(TForm)
lvSysProc: TListView;
lblSysProc: TLabel;
lblAboutProc: TLabel;
lvAboutProc: TListView;
lblCountSysProc: TLabel;
lblCountAboutProc: TLabel;
Panel: TPanel;
btnDetermine: TButton;
btnRefresh: TButton;
lblOthers: TLabel;
lblEmail: TLabel;
MyFlag: 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;
FormOldHeightFormOldWidth:Integer;
procedure SysTrayOnClick(var message:TMessage);message WM_SYSTRAYMSG;
public
{ Public declarations }
end;
var
Form: TForm;
idid: dword;
fp:tprocessentry;
fm:tmoduleentry;
SysTrayIcon:TNotifyIconData;
implementation
{$R *DFM}
function RegisterServiceProcess(dwProcessIDdwType:integer):integer;stdcall;external KERNELDLL;
procedure TFormbtnRefreshClick(Sender: TObject);
var
clp:bool;
newitem:Tlistitem;
MyIcon:TIcon;
IconIndex:word;
ProcFile : array[MAX_PATH] of char;
begin
MyIcon:=TIconcreate;
lvSysProcItemsclear;
lvSysProcSmallImagesclear;
fshandle:=CreateToolhelpSnapshot(thcs_snapprocess);
fpdwsize:=sizeof(fp);
clp:=processfirst(fshandlefp);
IconIndex:=;
while integer(clp)<> do
begin
if fpthprocessid<>getcurrentprocessid then
begin
newitem:=emsadd;
{
newitemcaption:=fpszexefile;
MyIconHandle:=ExtractIcon(FormHandlefpszexefile);
}
StrCopy(ProcFilefpszExeFile);
newitemcaption:=ProcFile;
MyIconHandle:=ExtractAssociatedIcon(HINSTANCEProcFileIconIndex);
if MyIconHandle<> then
begin
with lvSysProc do
begin
NewItemImageIndex:=smallimagesaddicon(MyIcon);
end;
end;
with newitemsubitems do
begin
add(IntToHex(fpthprocessid));
Add(IntToHex(fpthParentProcessID));
Add(IntToHex(fppcPriClassBase));
Add(IntToHex(tUsage));
Add(IntToStr(tThreads));
end;
end;
clp:=processnext(fshandlefp);
end;
closehandle(fshandle);
lblCountSysProccaption:=IntToStr(unt);
MyIconFree;
end;
procedure TFormbtnDetermineClick(Sender: TObject);
var
processhndle:thandle;
begin
with lvSysProc do
begin
if selected=nil then
begin
messagebox(formhandle请先选择要终止的进程!操作提示MB_OK+MB_ICONINFORMATION);
end
else
begin
if messagebox(formhandlepchar(终止+itemfocusedcaption+?)
终止进程mb_yesno+MB_ICONWARNING+MB_DEFBUTTON)=mryes then
begin
idid:=strtoint($+itemfocusedsubitems[]);
processhndle:=openprocess(PROCESS_TERMINATEbool()idid);
if integer(terminateprocess(processhndle))= then
messagebox(formhandlepchar(不能终止+itemfocusedcaption+!)
操作失败mb_ok+MB_ICONERROR)
else
begin
SelectedDelete;
lvAboutProcItemsClear;
lblCountSysProccaption:=inttostr(unt);
lblCountAboutProccaption:=;
end
end;
end;
end;
end;
procedure TFormlvSysProcClick(Sender: TObject);
var
newitem:Tlistitem;
clp:bool;
begin
if lvSysProcselected<>nil then
begin
idid:=strtoint($+emfocusedsubitems[]);
emsClear;
fshandle:=CreateToolhelpSnapshot(thcs_snapmoduleidid);
fmdwsize:=sizeof(fm);
clp:=ModuleFirst(fshandlefm);
while integer(clp)<> do
begin
newitem:=lvAboutProcItemsadd;
with newitem do
begin
caption:=fmszexepath;
with newitemsubitems do
begin
add(IntToHex(fmthmoduleid));
add(IntToHex(fmGlblcntUsage));
add(IntToHex(fmproccntUsage));
end;
end;
clp:=ModuleNext(fshandlefm);
end;
closehandle(fshandle);
lblCountAboutProcCaption:=IntToStr(unt);
end
end;
procedure TFormFormCreate(Sender: TObject);
begin
with application do
begin
showwindow(handleSW_HIDE); //隐藏任务栏上的任务按钮
OnMinimize:=AppOnMinimize; //最小化时自动隐藏
OnDeactivate:=FormDeactivate; //不活动时自动隐藏
OnActivate:=btnRefreshClick;
end;
RegisterServiceProcess(GetcurrentProcessID); //将程序注册为系统服务程序