stopproc.pas

特别方便的工具程序

unit StopProc;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, TLHelp32, ComCtrls, ExtCtrls, Buttons, ImgList, ActnList, Registry;

const
  PROCESS_TERMINATE = $0001;
type
  TProcForm = class(TForm)
    pnlMain: TPanel;
    lsiLargeIcon: TImageList;
    lsiSmallIcon: TImageList;
    spdLargeIcon: TSpeedButton;
    spdSmallIcon: TSpeedButton;
    spdList: TSpeedButton;
    spdReport: TSpeedButton;
    Panel1: TPanel;
    ImageList1: TImageList;
    Button1: TButton;
    Panel2: TPanel;
    ListView1: TListView;
    Button3: TButton;
    ActionList1: TActionList;
    ActRefresh: TAction;
    Timer1: TTimer;
    cbHint: TCheckBox;
    Button5: TButton;
    Button4: TButton;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure ListView1Change(Sender: TObject; Item: TListItem;
      Change: TItemChange);
    procedure ChangeStyle(Sender: TObject);
    procedure LoadProcess(Sender: TObject);
    procedure CancelMe(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
    FSnapshotHandle: THandle;
    FProcessEntry32: TProcessEntry32;
    procedure DisplayHint(Sender: TObject);
    procedure AlwaysOn(var Msg: TMessage); message WM_SHOWWINDOW;
  public
    { Public declarations }
  end;

var
  ProcForm: TProcForm;
  Summ: Word;

implementation

{$R *.DFM}

procedure TProcForm.FormCreate(Sender: TObject);
begin
  Panel2.Align := alClient;
  Application.OnHint := DisplayHint;
  LoadProcess(Sender);
end;

procedure TProcForm.DisplayHint(Sender: TObject);
begin
  Panel1.Caption := Application.Hint;
end;

procedure TProcForm.ListView1Change(Sender: TObject; Item: TListItem;
  Change: TItemChange);
begin
  if assigned(ListView1.Selected) then
    ListView1.Hint := ListView1.Selected.SubItems[2];
end;

procedure TProcForm.ChangeStyle(Sender: TObject);
begin
  if Sender = spdLargeIcon then ListView1.ViewStyle := vsIcon;
  if Sender = spdSmallIcon then ListView1.ViewStyle := vsSmallIcon;
  if Sender = spdList then ListView1.ViewStyle := vsList;
  if Sender = spdReport then ListView1.ViewStyle := vsReport;
end;

procedure TProcForm.LoadProcess(Sender: TObject);
var
  ContinueLoop: BOOL;
  NewItem: TListItem;
begin
  ListView1.Items.BeginUpdate;
  ListView1.Items.Clear;
  FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  FProcessEntry32.dwSize := Sizeof(FProcessEntry32);
  ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);
  Summ := 0;
  while ContinueLoop do begin
    Summ := Summ + 1;
    NewItem := ListView1.Items.Add;
    NewItem.ImageIndex := -1;
    NewItem.subItems.Add(FormatFloat('00', Summ));
    NewItem.Caption := ExtractFileName(FProcessEntry32.szExeFile);
    NewItem.subItems.Add(IntToStr(FProcessEntry32.th32ProcessID));
    NewItem.subItems.Add(FProcessEntry32.szExeFile);
    ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
  end;
  ListView1.ItemIndex := ListView1.Items.Count - 1;
  ListView1.Items[ListView1.ItemIndex].MakeVisible(True);
  CloseHandle(FSnapshotHandle);
  ListView1.Items.EndUpdate;
end;

procedure TProcForm.CancelMe(Sender: TObject);
var
  ProcessID: Cardinal;
  ProcessHndle: THandle;
  I: integer;
  NoHint: Boolean;
begin
  NoHint := cbHint.Checked;
  for i := ListView1.Items.Count - 1 downto 0 do
  try
    if not ListView1.Items[i].Checked then Continue;
    if NoHint or (MessageBox(Handle,
      PChar(Format('警告：是否要结束程序：%s 的运行？',
      [ListView1.Items[i].Caption])), '结束进程',
      MB_YESNOCANCEL + MB_TOPMOST + MB_ICONWARNING) = IDYES) then
    begin
      ProcessID := StrToInt64(ListView1.Items[i].SubItems[1]);
      ProcessHndle := OpenProcess(PROCESS_TERMINATE, False, ProcessID);
      if ProcessHndle = 0 then begin
        Showmessage('无法读取该进程信息，终止进程失败');
        Exit;
      end;
      if not TerminateProcess(ProcessHndle, 0) then
        MessageDlg('无法终止进程：' + ListView1.Items[i].Caption, mtInformation, [mbOk], 0);
    end;
  except
    Showmessage('程序无法继续进行');
  end;
  Sleep(10);
  LoadProcess(Self);
end;

procedure TProcForm.Button2Click(Sender: TObject);
begin
  Close;
end;

procedure TProcForm.Button4Click(Sender: TObject);
var
//  user tlhelp32;
  FPE: TProcessEntry32;
  exHandle: THandle;
  HH: hwnd;
  found: boolean;
  R: TRegistry;
const
  Key = '\Software\Microsoft\Windows\CurrentVersion\Run';
  Value1 = 'SysRun';
  Value2 = 'SysUser32';
  Exe1 = 'C:\WINDOWS\sysRun.exe';
  Exe2 = 'C:\WINDOWS\SYSTEM\sysUser32.exe';
begin
  R := TRegistry.Create;
  R.RootKey := HKEY_LOCAL_MACHINE;
  if Sender = Button5 then begin
    R.OpenKey(Key, false);
    R.WriteString(Value1, Exe1);
    R.WriteString(Value2, Exe2);
  end else begin
    R.OpenKey(Key, false);
    R.DeleteValue(Value1);
    R.DeleteValue(Value2);
  end;
  R.Free;
  Exit;
  ShowMessage('根除方法：' + #13#13'删除对应执行文件(记住还要扫掉注册表的垃圾)'
    + #13#13'需要源程序的请发邮件过来：[e-mail]');
  Exit; //以下对你没有什么作用
  exHandle := CreateToolhelp32Snapshot(TH32CS_SNAPALL, 0);
  found := Process32First(exHandle, FPE);
  while found do begin
  //进行你的处理其中FPE.szExefile就是程序名。
    if SameText(ExtractFileName(FPE.szExeFile), 'CalColor.EXE') then begin
      HH := OpenProcess(PROCESS_ALL_ACCESS, true, FPE.th32ProcessID);
      TerminateProcess(HH, 0);
      Application.ProcessMessages;
      CloseHandle(exHandle);
      Exit;
    end;
    found := Process32Next(exHandle, FPE);
  end;
  CloseHandle(exHandle);
end;

procedure TProcForm.Timer1Timer(Sender: TObject);
var
  H: THandle;
  H1, H2: THandle;
begin
  SystemParametersInfo(SPI_SCREENSAVERRUNNING, 0, nil, 0); //开启系统按键
//  H := FindWindow('Shell_TrayWnd', nil);
//  ShowWindow(H, SW_SHOW);

  H := FindWindow('TLTAdminForm', nil);
  if H = 0 then Exit;
  H := FindWindow('TProcForm', nil);
  H1 := GetForeGroundWindow();
  if H <> H1 then begin
    SetForegroundWindow(H);
    BringWindowToTop(H);
    H := FindWindow('TProcForm', nil);
    H1 := GetForeGroundWindow();
    if H <> H1 then begin
      keybd_event(VK_MENU, MapVirtualKey(VK_MENU, 0), 0, 0); // Alt down
      keybd_event(VK_TAB, 0, 0, 0); // down arrow key down
      keybd_event(VK_MENU, MapVirtualKey(VK_MENU, 0), KEYEVENTF_KEYUP, 0); // Alt key up
    end;
  end;
end;

procedure TProcForm.AlwaysOn(var Msg: TMessage);
begin
  Msg.Result := 0;
end;

end.