本程序通過調用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: 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; FormOldHeight,FormOldWidth:Integer; procedure SysTrayOnClick(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: TObject); 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: TObject); 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_ICONERROR) else begin Selected.Delete; lvAboutProc.Items.Clear; lblCountSysProc.caption:=inttostr(lvSysProc.items.count); lblCountAboutProc.caption:=''; end end; end; end; end;
procedure TForm1.lvSysProcClick(Sender: TObject); 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: TObject); 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:TObject); begin ShowWindow(application.handle,SW_HIDE); end;
//響應鼠標在系統托盤區圖標上點擊 procedure tform1.SysTrayOnClick(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: TObject; var Action: TCloseAction); begin Shell_NotifyIcon(NIM_DELETE,@SysTrayIcon); //取消系統托盤區圖標 RegisterServiceProcess(GetcurrentProcessID,0); //取消系統服務程序的注冊 lvSysProc.SmallImages.Free; end;
//不活動時自動隱藏 procedure TForm1.FormDeactivate(Sender: TObject); begin application.minimize; end;
procedure TForm1.lblEmailClick(Sender: TObject); begin if ShellExecute(Handle,'Open',Pchar('Mailto:purpleendurer@163.com'),nil,nil,SW_SHOW)<33 then MessageBox(form1.Handle,'無法啟動電子郵件軟件!','我很遺憾',MB_ICONINFORMATION+MB_OK); end;
//當窗體大小改變時調整各組件位置 procedure TForm1.FormResize(Sender: TObject); 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:purpleendurer@163.com與我討論。
作者:黃志斌 廣西河池地區經濟學校 郵編:547000 Email: purpleendurer@163.com
|