用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); //將程序注冊為系統服務程序
From:http://tw.wingwit.com/Article/program/Delphi/201311/24680.html