main.pas

delphi开发的进程监视程序

unit Main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls,
  ShellAPI, ToolWin, ImgList, Menus, ExtCtrls;

const
  MY_MESSAGE = WM_USER + 100;

type
  TFormProc = class(TForm)
    PopupMenuTray: TPopupMenu;
    NClose: TMenuItem;
    NCloseMenu: TMenuItem;
    Timer: TTimer;
    MemoKilled: TMemo;
    Bar: TStatusBar;
    N1: TMenuItem;
    NS1: TMenuItem;
    NS2: TMenuItem;
    NS3: TMenuItem;
    NS5: TMenuItem;
    NS10: TMenuItem;
    NS20: TMenuItem;
    NS30: TMenuItem;
    NS60: TMenuItem;
    NStopMon: TMenuItem;
    NInMon: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure WMSysCommand(var Msg: TWMSysCommand); message WM_SYSCOMMAND;
    procedure ToolButtonClose(Sender: TObject);
    procedure TimerTimer(Sender: TObject);
    procedure SetInterTimeClick(Sender: TObject);
    procedure ChangeState(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    NextClipHwnd: HWND;//观察链中下一个窗口句柄
    procedure OnIconNotify(var Message: TMessage); message MY_MESSAGE;
  end;

var
  FormProc: TFormProc;

implementation
{$R *.dfm}
uses
  tlHelp32, psAPI;
var
  BlackProcessTable: TStringList;

procedure AddTrayIcon(hIcon: THandle);
var
  nid: TNotifyIconData;
begin
  nid.cbSize := sizeof(nid); // nid变量的字节数
  nid.Wnd := FormProc.Handle; // 主窗口句柄
  nid.uID := 131313; // 内部标识，可设为任意数
  nid.hIcon := hIcon;; // 要加入的图标句柄，可任意指?
  strpcopy(nid.szTip, FormProc.Caption); // 提示字符串
  nid.uCallbackMessage := MY_MESSAGE; // 回调函数消息
  nid.uFlags := NIF_ICON or NIF_TIP or NIF_MESSAGE; // 指明哪些字段有?

  if not Shell_NotifyIcon(NIM_ADD, @nid) then
    ShowMessage('AddIconFail!');
end;

procedure ModifyTrayIcon(hIcon: THandle);
var
  nid: TNotifyIconData;
begin
  nid.cbSize := sizeof(nid); // nid变量的字节数
  nid.Wnd := FormProc.Handle; // 主窗口句柄
  nid.uID := 131313; // 内部标识，可设为任意数
  nid.hIcon := hIcon;; // 要加入的图标句柄，可任意指?
  strpcopy(nid.szTip, FormProc.Caption); // 提示字符串
  nid.uCallbackMessage := MY_MESSAGE; // 回调函数消息
  nid.uFlags := NIF_ICON or NIF_TIP or NIF_MESSAGE; // 指明哪些字段有?

  if not Shell_NotifyIcon(NIM_MODIFY, @nid) then
    ShowMessage('ModifyIconFail!');
end;

{程序被关闭时通知Windows去掉小图标}
procedure DelTrayIcon;
var
  nid: TNotifyIconData;
begin
  nid.uID := 131313; //内部标识，与加入小图标时的数一致
  nid.Wnd := FormProc.Handle; //主窗口句柄
  if not Shell_NotifyIcon(NIM_DELETE, @nid) then
    ShowMessage('DelIconFail!');
end;

procedure TFormProc.WMSysCommand(var Msg: TWMSysCommand);
begin
  if (Msg.CmdType = SC_MINIMIZE) or (Msg.CmdType = SC_CLOSE) then
  begin
    self.hide;
  end
  else
    inherited;
end;

{当小图标捕捉到鼠标事件时进入此过程}
procedure TFormProc.OnIconNotify(var Message: TMessage);
var
  p: TPoint;
begin
  if Message.LParam = WM_LBUTTONDOWN then
  begin
    //if not Application.Active then
    if not FormProc.Visible then
    begin
      FormProc.Show;
    end
    else
      FormProc.Hide;
    //Application.BringToFront;
    //Application.Restore;
  end;
  if Message.LParam = WM_RBUTTONDOWN then
  begin
    GetCursorPos(p);
    PopupMenuTray.Popup(p.X,p.Y);
  end;
end;

///////////////////////////////
procedure CheckProc(ProcFileName: string; ProcID: Integer);
var
  I: Integer; 
  UExitCode: byte;
  ProcessHandle: THandle;
begin
  if BlackProcessTable.Count = 0 then Exit;
  for I := 0 to BlackProcessTable.Count - 1 do
  begin
    if ProcFileName = Trim(BlackProcessTable.Strings[I]) then
    begin
      ProcessHandle := OpenProcess(PROCESS_TERMINATE, False, ProcID);
      TerminateProcess(ProcessHandle, UExitCode);
      FormProc.MemoKilled.Lines.Add('阻截恶意进程: ' + ProcFileName);
    end;
  end;
end;

procedure SearchProcesses;
var
  hSnap: THandle;
  ProcessEntry: TProcessEntry32;
  Proceed: Boolean;
begin
  hSnap := CreateToolhelp32Snapshot( TH32CS_SNAPALL, 0 ); //创建系统快照
  if HSnap <> - 1 then
  begin
    ProcessEntry.dwSize := SizeOf(TProcessEntry32); //先初始化 FProcessEntry32 的大小
    Proceed := Process32First(hSnap, ProcessEntry);
    while Proceed do
    begin
      with ProcessEntry do
      begin
        CheckProc(szEXEFile, Th32ProcessID);
        //Th32ProcessID;
        //th32ParentProcessID;
        //Th32ModuleID;
        //cntUsage;
        //cntThreads;
        //pcPriClassBase;
      end;
      Proceed := Process32Next( hSnap, ProcessEntry);
    end;
    CloseHandle( hSnap );
  end
  else
    ShowMessage( 'Oops...' + SysErrorMessage(GetLastError));
end;

procedure TFormProc.FormCreate(Sender: TObject);
begin
  FormProc.Icon := Application.Icon;
  BlackProcessTable := TStringList.Create;
  BlackProcessTable.LoadFromFile(ExtractFilePath(ParamStr(0))+'ProcBlackName.ini');
  AddTrayIcon(Application.Icon.Handle);
  {将程序的窗口样式设为TOOL窗口，可避免在任务条上出现}
  SetWindowLong(Application.Handle, GWL_EXSTYLE, WS_EX_TOOLWINDOW);
end;

procedure TFormProc.FormDestroy(Sender: TObject);
begin
  DelTrayIcon;
  BlackProcessTable.free;
end;

procedure TFormProc.ToolButtonClose(Sender: TObject);
begin
  Application.Terminate;
end;

procedure TFormProc.TimerTimer(Sender: TObject);
begin
  SearchProcesses;
end;

procedure TFormProc.SetInterTimeClick(Sender: TObject);
begin
  Timer.Interval := (Sender as TMenuItem).Tag*1000;
end;

procedure TFormProc.ChangeState(Sender: TObject);
begin
  if (Sender as TMenuItem).Tag = 1 then
    Timer.Enabled :=  True
  else
    Timer.Enabled :=  False;
end;

end.