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

    本步调经过挪用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