飘云阁同时杀多进程小工具代码 - Powered by Discuz! Archiver

eopenfang 发表于 2006-11-17 15:59:40

同时杀多进程小工具代码

前些时间写了个专杀工具,用到网上下载来的代码,感觉不错,发出来共享下!呵.呵......好东西要分享!!!
//程序源代码

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls,tlhelp32;

type
TForm1 = class(TForm)
ListBox1: TListBox;
Button1: TButton;
Button2: TButton;
Button3: TButton;
ListBox2: TListBox;
Label1: TLabel;
Button4: TButton;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Edit1: TEdit;
Label5: TLabel;
ListBox3: TListBox;
Button5: TButton;
Button6: TButton;
Button7: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure ListBox1DblClick(Sender: TObject);
procedure Button6Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure Button7Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
ProcessID:array of dword;
ModuleID:array of dword;
implementation

{$R *.dfm}
function EnableDebugPrivilege: Boolean;
function EnablePrivilege(hToken: Cardinal; PrivName: string; bEnable: Boolean): Boolean;
var
TP: TOKEN_PRIVILEGES;
Dummy: Cardinal;
begin
TP.PrivilegeCount := 1;
LookupPrivilegeValue(nil, pchar(PrivName), TP.Privileges.Luid);
if bEnable then
TP.Privileges.Attributes := SE_PRIVILEGE_ENABLED
else TP.Privileges.Attributes := 0;
AdjustTokenPrivileges(hToken, False, TP, SizeOf(TP), nil, Dummy);
Result := GetLastError = ERROR_SUCCESS;
end;
var
hToken: Cardinal;
begin
OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES, hToken);
if EnablePrivilege(hToken, 'SeDebugPrivilege', True) then
result:=true
else
result:=false;
CloseHandle(hToken);
end;
function KillTask(ExeFileName: string): Integer;
const
PROCESS_TERMINATE = $0001;
var
ContinueLoop: BOOL;
FSnapshotHandle: THandle;
FProcessEntry32: TProcessEntry32;
begin
Result := 0;
FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
FProcessEntry32.dwSize := SizeOf(FProcessEntry32);
ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);

while Integer(ContinueLoop) <> 0 do
begin
if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) =
UpperCase(ExeFileName)) or (UpperCase(FProcessEntry32.szExeFile) =
UpperCase(ExeFileName))) then
Result := Integer(TerminateProcess(
OpenProcess(PROCESS_TERMINATE,
BOOL(0),
FProcessEntry32.th32ProcessID),
0));
ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
end;
CloseHandle(FSnapshotHandle);
end;
function KillDll(aDllName: string): Boolean;
var
hDLL: THandle;
aName: array of char;
FoundDLL: Boolean;
begin
StrPCopy(aName, aDllName);
FoundDLL := False;
repeat
hDLL := GetModuleHandle(aName);
if hDLL = 0 then
Break;
FoundDLL := True;
FreeLibrary(hDLL);
until (FoundDLL=false);
if FoundDLL then
MessageDlg('Success!', mtInformation, , 0)
else
MessageDlg('DLL not found!', mtInformation, , 0);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
ProcessListHandle:thandle;
ProcessStruct:tPROCESSENTRY32;
i:integer;
yn:bool;
begin
ProcessListHandle:=CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0);
ListBox1.Items.Clear;
ProcessStruct.dwSize:=sizeof(ProcessStruct);
yn:=Process32First(ProcessListHandle,ProcessStruct);
I:=0;
while integer(yn)<>0 do
begin
ProcessID:=ProcessStruct.th32ProcessID;
ListBox1.Items.Add(ProcessStruct.szExeFile);
yn:=Process32Next(ProcessListHandle,ProcessStruct);
i:=i+1;
end;

end;

procedure TForm1.Button2Click(Sender: TObject);
var
i:integer;
pid:integer;
h:thandle;
ExitCode:DWORD;
begin
i:=listbox1.ItemIndex;
if i<>-1 then
begin

pID:=ProcessID;
h:=OpenProcess(PROCESS_ALL_ACCESS,true,pID);
GetExitCodeProcess(h,ExitCode); // 取中止码
TerminateProcess(h,ExitCode); // 强行中止
Sleep(100);       // 延时100ms
Button1.Click;    // 重新列表
end;

end;

procedure TForm1.Button3Click(Sender: TObject);
var
i,j,pID:integer;
yn:bool;
ModuleListHandle:thandle;
ModuleStruct:tMODULEENTRY32;
begin
i:=ListBox1.ItemIndex;
if (i<>-1) then
begin
pID:=ProcessID; // 列这个进程的DLL名
ModuleListHandle:=CreateToolhelp32Snapshot(TH32CS_SNAPMODULE,pID);
ListBox2.Items.Clear;
j:=0;
ModuleStruct.dwSize:=sizeof(ModuleStruct);
yn:=Module32First(ModuleListHandle,ModuleStruct);
while integer(yn)<>0 do
begin
ModuleID:=ModuleStruct.th32ModuleID;
if j=0 then
edit1.Text:=ModuleStruct.szExePath
else
ListBox2.Items.Add(ModuleStruct.szExePath);
yn:=Module32Next(ModuleListHandle,ModuleStruct);
j:=j+1;
end;
if listbox2.Count=0 then
label1.Caption:='共：0个DLL'
else
label1.Caption:='共：' + inttostr(listbox2.Count-1) + '个DLL';
end;

end;

procedure TForm1.Button4Click(Sender: TObject);
var
ext,dllname:string;
begin
messagebox(handle,pchar('未完善'),pchar('提示'),mb_iconinformation or mb_ok);
if listbox2.Count<>0 then
begin
if (listbox2.ItemIndex<>-1) and (listbox2.ItemIndex<>0) then
begin
ext:=extractfileext(listbox2.Items);
if lowercase(copy(ext,2,3))='dll' then
begin
dllname:=listbox2.Items;
KillDll(dllname);
end;
end;
end;
end;

procedure TForm1.ListBox1DblClick(Sender: TObject);
var
i:integer;
begin
for i:=0 to listbox3.Items.Count-1 do
begin
if listbox3.Items=listbox1.Items then
begin
messagebox(handle,pchar('进程已被添加'),pchar('提示'),mb_iconinformation or mb_ok);
exit;
end;
end;
listbox3.Items.Add(listbox1.Items) ;

end;

procedure TForm1.Button6Click(Sender: TObject);
var i:integer;
begin
if EnableDebugPrivilege then
if messagebox(handle,pchar('如果该进程为系统关键进程将会导致系统崩溃，您确定关闭进程吗？'),'关闭进程',mb_yesno or mb_iconinformation)=idyes then
begin
for i:=0 to listbox3.Items.Count-1 do
begin
KillTask(listbox3.Items);
end;
listbox1.Items.Clear;
end;
sleep(1000);
Button1.Click;    // 重新列表
listbox3.Items.Clear;
end;

procedure TForm1.Button5Click(Sender: TObject);
var
cc:integer;
begin
cc:=listbox3.ItemIndex ;
if cc<>-1 then
begin
listbox3.DeleteSelected;
end;
end;

procedure TForm1.Button7Click(Sender: TObject);
begin
messagebox(handle,pchar('请慎用杀多进程，他可以杀掉任何进程'#13'本程序只同时杀不同名的进程，同名的有哪位知道的请联系我'#13'QQ:104819582'),'关闭进程',mb_OK or mb_iconinformation)
end;

end.

我的家园

追梦·love 发表于 2006-11-20 22:28:15

收下慢慢看，支持！

yfd11 发表于 2006-11-21 14:55:58

用XP自带的命令也可以

C:\>taskkill /?

TASKKILL ]]]
      { }

描述:
这个命令行工具可用来结束至少一个进程。
可以根据进程 id 或图像名来结束进程。

参数列表:
/S system       指定要连接到的远程系统。

/U user 指定应该在哪个用户上下文
                        执行这个命令。

/P    为提供的用户上下文指定
                        密码。如果忽略，提示输入。

/F                   指定要强行终止
                        进程。

/FI filter       指定筛选进或筛选出查询的
                        的任务。

/PIDprocess id    指定要终止的进程的
                        PID。

/IM image name    指定要终止的进程的
                        图像名。通配符 '*'
                        可用来指定所有图像名。

/T                   Tree kill: 终止指定的进程
                        和任何由此启动的子进程。

/?                   显示帮助/用法。

筛选器:
筛选器名    有效运算符             有效值
----------- ---------------       --------------
STATUS    eq, ne                运行 | 没有响应
IMAGENAME eq, ne                图像名
PID       eq, ne, gt, lt, ge, le PID 值
SESSION    eq, ne, gt, lt, ge, le 会话编号
CPUTIME    eq, ne, gt, lt, ge, le CPU 时间，格式为
                                       hh:mm:ss。
                                       hh - 时，
                                       mm - 钟，ss - 秒
MEMUSAGE    eq, ne, gt, lt, ge, le 内存使用，单位为 KB
USERNAME    eq, ne                用户名，格式为
                                       user
MODULES    eq, ne                DLL 名
SERVICES    eq, ne                服务名
WINDOWTITLE eq, ne                窗口标题

注意: 只有带有筛选器的情况下，才能跟 /IM 切换使用通配符 '*'。

注意: 远程进程总是要强行终止，
   不管是否指定了 /F 选项。

例如:
TASKKILL /S system /F /IM notepad.exe /T
TASKKILL /PID 1230 /PID 1241 /PID 1253 /T
TASKKILL /F /IM notepad.exe /IM mspaint.exe
TASKKILL /F /FI "PID ge 1000" /FI "WINDOWTITLE ne untitle*"
TASKKILL /F /FI "USERNAME eq NT AUTHORITY\SYSTEM" /IM notepad.exe
TASKKILL /S system /U domain\username /FI "USERNAME ne NT*" /IM *
TASKKILL /S system /U username /P password /FI "IMAGENAME eq note*"

黑夜彩虹 发表于 2006-11-28 19:26:53

Delphi源码就是要顶。。。

枫影发表于 2006-11-29 09:02:16

同名的进程用PID来驱别吧!

页: [1]

飘云阁's Archiver

同时杀多进程小工具代码

用XP自带的命令也可以