其他语言

位置:IT落伍者 >> 其他语言 >> 浏览文章

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


发布日期:2018年12月22日
 
用Delphi编写系统进程监控程序
本程序通过调用kerneldll中的几个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); //将程序注册为系统服务程序               

上一篇:Delphi部分函数、命令、属性中文说明

下一篇:Delphi与C++之间通过实现函数与对象共享