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

本程序通过调用kernel dll中的几个API 函数 搜索并列出系统中除本进程外的所有进程的ID 对应的文件说明符 优先级 CPU占有率 线程数 相关进程信息等有关信息 并可中止所选进程 本程序运行时会在系统托盘区加入图标 不会出现在按Ctrl+Alt+Del出现的任务列表中 也不会在任务栏上显示任务按钮 在不活动或最小化时会自动隐藏 不会重复运行 若程序已经运行 再想运行时只会激活已经运行的程序 本程序避免程序反复运行的方法是比较独特的 因为笔者在试用网上介绍一些方法后 发现程序从最小化状态被激活时 单击窗口最小化按钮时 窗口却不能最小化 于是笔者采用了发送和处理自定义消息的方法 在程序运行时先枚举系统中已有窗口 若发现程序已经运行 就向该程序窗口发送自定义消息 然后结束 已经运行的程序接到自定义消息后显示出窗口 //工程文件procviewpro dprprogram procviewprousesForms windows messages main in procview pas {Form }{$R * RES}{//这是系统自动的beginApplication InitializeApplication Title := 系统进程监控 Application CreateForm(TForm Form )Application Runend }varmyhwnd:hwndbeginmyhwnd := FindWindow(nil 系统进程监控 )// 查找窗口if myhwnd= then // 没有发现 继续运行beginApplication InitializeApplication Title := 系统进程监控 Application CreateForm(TForm Form )Application Runendelse //发现窗口 发送鼠标单击系统托盘区消息以激活窗口postmessage(myhwnd WM_SYSTRAYMSG wm_lbuttondown){//下面的方法的缺点是 若窗口原先为最小化状态 激活后单击窗口最小化按钮将不能最小化窗口showwindow(myhwnd sw_restore)FlashWindow(MYHWND TRUE)}end {//下面是使用全局原子的方法避免程序反复运行constatomstr= procview varatom:integerbeginif globalfindatom(atomstr)= thenbeginatom:=globaladdatom(atomstr)with application dobeginInitializeTitle := 系统进程监控 CreateForm(TForm Form )Runendglobaldeleteatom(atom)endend }//单元文件procview pasunit procviewinterfaceusesWindows Messages SysUtils Classes Graphics Controls Forms Dialogs StdCtrls TLHelp Buttons ComCtrls ExtCtrls ShellAPI MyFlagconstPROCESS_TERMINATE= SYSTRAY_ID= WM_SYSTRAYMSG=WM_USER+ typeTForm = class(TForm)lvSysProc: TListViewlblSysProc: TLabellblAboutProc: TLabellvAboutProc: TListViewlblCountSysProc: TLabellblCountAboutProc: TLabelPanel : TPanelbtnDetermine: TButtonbtnRefresh: TButtonlblOthers: TLabellblEmail: TLabelMyFlag : TMyFlagprocedure btnRefreshClick(Sender: TObject)procedure btnDetermineClick(Sender: TObject)procedure lvSysProcClick(Sender: TObject)procedure FormCreate(Sender: TObject)procedure AppOnMinimize(Sender:TObject)procedure FormClose(Sender: TObjectvar Action: TCloseAction)procedure FormDeactivate(Sender: TObject)procedure lblEmailClick(Sender: TObject)procedure FormResize(Sender: TObject)private{ Private declarations }fshandle:thandleFormOldHeight FormOldWidth:Integerprocedure SysTrayOnClick(var message:TMessage)message WM_SYSTRAYMSGpublic{ Public declarations }endvarForm : TForm idid: dwordfp :tprocessentry fm :tmoduleentry SysTrayIcon:TNotifyIconDataimplementation{$R * DFM}function RegisterServiceProcess(dwProcessID dwType:integer):integerstdcallexternal KERNEL DLL procedure TForm btnRefreshClick(Sender: TObject)varclp:boolnewitem :TlistitemMyIcon:TIconIconIndex:wordProcFile : array[ MAX_PATH] of charbeginMyIcon:=TIcon createlvSysProc Items clearlvSysProc SmallImages clearfshandle:=CreateToolhelp Snapshot(th cs_snapprocess )fp dwsize:=sizeof(fp )clp:=process first(fshandle fp )IconIndex:= while integer(clp)<>dobeginif fp th processid<>getcurrentprocessid thenbeginnewitem :=ems add{newitem caption:=fp szexefileMyIcon Handle:=ExtractIcon(Form Handle fp szexefile )}StrCopy(ProcFile fp szExeFile)newitem caption:=ProcFileMyIcon Handle:=ExtractAssociatedIcon(HINSTANCE ProcFile IconIndex)if MyIcon Handle<>thenbeginwith lvSysProc dobeginNewItem ImageIndex:= *** allimages addicon(MyIcon)endendwith newitem subitems dobeginadd(IntToHex(fp th processid ))Add(IntToHex(fp th ParentProcessID ))Add(IntToHex(fp pcPriClassBase ))Add(IntToHex(tUsage ))Add(IntToStr(tThreads))endendclp:=process next(fshandle fp )endclosehandle(fshandle)lblCountSysProc caption:=IntToStr(unt)MyIcon Freeendprocedure TForm btnDetermineClick(Sender: TObject)varprocesshndle:thandlebeginwith lvSysProc dobeginif selected thenbeginmessagebox(form handle 请先选择要终止的进程! *** 作提示 MB_OK+MB_ICONINFORMATION)endelsebeginif messagebox(form handle pchar( 终止 +itemfocused caption+ ? ) 终止进程 mb_yesno+MB_ICONWARNING+MB_DEFBUTTON )=mryes thenbeginidid:=strtoint( $ +itemfocused subitems[ ])processhndle:=openprocess(PROCESS_TERMINATE bool( ) idid)if integer(terminateprocess(processhndle ))= thenmessagebox(form handle pchar( 不能终止 +itemfocused caption+ ! ) *** 作失败 mb_ok+MB_ICONERROR)elsebeginSelected DeletelvAboutProc Items ClearlblCountSysProc caption:=inttostr(unt)lblCountAboutProc caption:= endendendendendprocedure TForm lvSysProcClick(Sender: TObject)varnewitem :Tlistitemclp:boolbeginif lvSysProc selected<>nil thenbeginidid:=strtoint( $ +emfocused subitems[ ])ems Clearfshandle:=CreateToolhelp Snapshot(th cs_snapmodule idid)fm dwsize:=sizeof(fm )clp:=Module First(fshandle fm )while integer(clp)<>dobeginnewitem :=lvAboutProc Items addwith newitem dobegincaption:=fm szexepathwith newitem subitems dobeginadd(IntToHex(fm th moduleid ))add(IntToHex(fm GlblcntUsage ))add(IntToHex(fm proccntUsage ))endendclp:=Module Next(fshandle fm )endclosehandle(fshandle)lblCountAboutProc Caption:=IntToStr(unt)endendprocedure TForm FormCreate(Sender: TObject)beginwith application dobeginshowwindow(handle SW_HIDE)//隐藏任务栏上的任务按钮OnMinimize:=AppOnMinimize//最小化时自动隐藏OnDeactivate:=FormDeactivate//不活动时自动隐藏OnActivate:=btnRefreshClickendRegisterServiceProcess(GetcurrentProcessID )//将程序注册为系统服务程序 lishixinzhi/Article/program/Delphi/201311/24680

建议不要用FindNextChangeNotification，因为确实不清楚如何获得改变了的文件名，API的话可以使用ReadDirectoryChangesW来完成这个任务（当然还有一个也很好的API SHChangeNotifyRegister）。驱动层的监视更为好，不过这里我就不谈了。

char *strDir = "k:/temp/Other"

HANDLE hDirectory

hDirectory = CreateFile( strDir, GENERIC_READ|GENERIC_WRITE,

FILE_SHARE_READ|FILE_SHARE_WRITE|FILE_SHARE_DELETE,

NULL, OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, NULL

)

const unsigned int dwListBaseLength = sizeof( FILE_NOTIFY_INFORMATION ) + MAX_PATH

char buffer[ dwListBaseLength ] = { 0 }

FILE_NOTIFY_INFORMATION *pNotify = (FILE_NOTIFY_INFORMATION *) buffer

DWORD BytesReturned = 0

ReadDirectoryChangesW( hDirectory, pNotify, sizeof(buffer),

true, FILE_NOTIFY_CHANGE_FILE_NAME, &BytesReturned, NULL, NULL )

ShowMessage( WideCharToString( pNotify->FileName ) )

我是用bcb写的，你将她转为delphi就行了。

---