1,183
社区成员
发帖
与我相关
我的任务
分享
library process;
uses
SysUtils,
Windows,
Classes,
ComCtrls,
TLHelp32,
System,
Psapi;
{$R *.res}
function GetProcessList(LV: TListView): Integer; stdcall;
var listView: TListView;
FSnapshotHandle: THandle;
totalProcess: Integer;
IsLoopContinue: BOOL;
FProcessEntry32: TProcessEntry32;
newItem: TListItem;
processHandle: THandle;
modName: Array[0..511] of char;
n: DWORD;
processID: Integer;
hMod: HModule;
begin
totalProcess:= 0;
listView := LV;
listView.Items.BeginUpdate;
listView.Items.Clear;
{读取系统进程,并添加到listview}
FSnapshotHandle := CreateToolhelp32SnapShot(TH32CS_SNAPPROCESS,0); //创建系统快照
FProcessEntry32.dwSize := SizeOf(FProcessEntry32); //设置结构大小
IsLoopContinue := Process32First(FsnapshotHandle, FProcessEntry32); //得到第一个进程信息
while Integer(IsLoopContinue) <> 0 do
begin
//进程总数加1
totalProcess := totalProcess + 1;
//获取进程ID
processID := FProcessEntry32.th32ProcessID;
//列表添加一行
newItem := listView.Items.Add;
newItem.Caption := IntToStr(processID);//显示进程ID
//列表行增加进程名
newItem.SubItems.Add(ExtractFileName(FProcessEntry32.szExeFile));
//获取进程句柄
processHandle := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ,
false,
processID);
if processHandle <> 0 then
try
ENumProcessModules(processHandle, @hMod, SizeOf(hMod), n);
if GetModuleFileNameEx(processHandle, hMod, modName, SizeOf(modName)) > 0
then
newItem.SubItems.Add(ExtractFilePath(modName));
CloseHandle(processHandle);
except
MessageBox(0,'获取进程路径出错','出错了',MB_OK);
end;
IsLoopContinue := Process32Next(FsnapShotHandle, FProcessEntry32);
end;
CloseHandle(FSnapshotHandle);
listView.Items.EndUpdate;
Result := totalProcess;exit; //return
end;
exports
GetProcessList;
begin
end.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Menus, ComCtrls;
type
TGetProcessList = function(LV: TListView):Integer; stdcall;
TFrmMain = class(TForm)
btnKillProcess: TButton;
GroupBox1: TGroupBox;
MenuBar: TMainMenu;
N1: TMenuItem;
Q1: TMenuItem;
LVProcessList: TListView;
Label1: TLabel;
LblTotalProcess: TLabel;
procedure FormCreate(Sender: TObject);
procedure btnKillProcessClick(Sender: TObject);
procedure Q1Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
GetProcessList :TGetProcessList;
FarProc:TFarProc;
totalProcess :Integer;
public
{ Public declarations }
end;
var
FrmMain: TFrmMain;
DLLHandle: Cardinal;
implementation
{$R *.dfm}
{
完成ListView的界面初始化,外部DLL的加载
}
procedure TFrmMain.FormCreate(Sender: TObject);
begin
{ 初始LVProcessList}
with LVProcessList do
begin
try
ViewStyle := vsReport;
RowSelect := true;
Font.Color := clBlack;
Columns.Add;
Column[0].Caption := 'PID';
Column[0].AutoSize := false;
Column[0].Width := 60;
Column[0].Alignment := taLeftJustify;
Columns.Add;
Column[Columns.Count - 1].Caption := '映像名称';
Column[Columns.Count - 1].AutoSize := false;
Column[Columns.Count - 1].Width := 120;
Column[Columns.Count - 1].Alignment := taLeftJustify;
Columns.Add;
Column[Columns.Count - 1].Caption := '程序路径';
Column[Columns.Count - 1].AutoSize := false;
Column[Columns.Count - 1].Width := 310;
Column[Columns.Count - 1].Alignment := taLeftJustify;
except
messagebox(handle,'出错','!',MB_OK);
end;
end;
{ 加载process.dll}
DLLHandle := LoadLibrary('lib\process.dll');
if DLLHandle <> 0 then
begin
{获取外部函数的地址,
该外部函数负责列出系统所有当前的进程,
并显示到ListView控件,传递给的参数是
主Form的LVProcesslist控件}
FarProc := GetProcAddress(DLLHandle, 'GetProcessList');
if Assigned(FarProc) then
begin
GetProcessList := FarProc;
totalProcess := GetProcessList(LVProcessList);{ 开始获取系统进程,并在LVProcessList控件中显示 }
LblTotalProcess.Caption := IntToStr(totalProcess);
end;
end
else
begin
MessageBox(handle,'加载lib\process.dll失败','程序出错了',MB_OK);
Application.Terminate;
end;
end;
procedure TFrmMain.btnKillProcessClick(Sender: TObject);
var userChoice: Integer;
begin
userChoice := MessageBox(handle,'警告:终止进程可能会有不希望的结果发生,确定要结束吗?','确认消息',MB_OKCANCEL);
if userChoice = IDOK then
begin
//
end;
if UserChoice = IDCANCEL then
begin
//
end;
end;
procedure TFrmMain.Q1Click(Sender: TObject);
begin
close;
end;
procedure TFrmMain.FormDestroy(Sender: TObject);
begin
if DLLHandle <> 0 then
FreeLibrary(DLLHandle);
end;
end.
procedure TFrmMain.FormDestroy(Sender: TObject);
var i,j: Integer;
begin
for i := LVProcessList.Items.Count - 1 downto 0 do
begin
for j := LVProcessList.Items.Item[i].SubItems.Count - 1 downto 0 do
begin
LVProcessList.Items.Item[i].SubItems.Delete(j);
end;
LVProcessList.Items.Item[i].SubItems.Free;
{ 使用下面两句会报错 }
//LVProcessList.Items.Delete(i);
//LVProcessList.Items.Free;
end;
if DLLHandle <> 0 then
FreeLibrary(DLLHandle);
end;