熱點推薦:
您现在的位置: 電腦知識網 >> 編程 >> Delphi編程 >> 正文

用Delphi編寫系統進程監控程序

2013-11-23 17:29:46  來源: 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
    推薦文章
    Copyright © 2005-2013 電腦知識網 Computer Knowledge   All rights reserved.