如何在delphi中列出当前正在运行的进程,并可以选择终止某个或全部进程???(200分)

  • 主题发起人 主题发起人 gf.z
  • 开始时间 开始时间
G

gf.z

Unregistered / Unconfirmed
GUEST, unregistred user!
我有一个列出进程的代码,但不知道如何来终止进程!!
请教详细的可用代码》???
 
ProcessID := ProcessEntry.th32ProcessID;
ProcessWnd := OpenProcess(PROCESS_ALL_ACCESS, true, ProcessID);
ProcessExit := TerminateProcess(ProcessWnd, 0);
 
能写的详细点吗??谢谢!!1
 
unit Unit1;
interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, TLHelp32, ExtCtrls, ComCtrls;

type
TForm1 = class(TForm)
Panel1: TPanel;
Panel2: TPanel;
ProcessList: TTreeView;
ProcessParams: TListView;
Splitter1: TSplitter;
Panel5: TPanel;
Panel6: TPanel;
ThreadParams: TListView;
Panel9: TPanel;
ExitBtn: TButton;
Splitter2: TSplitter;
Button1: TButton;
ThreadList: TListView;
Panel10: TPanel;
HeapList: TListView;
HeapParams: TListView;
Splitter3: TSplitter;
Panel13: TPanel;
BlockList: TListView;
BlockParams: TListView;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
Label7: TLabel;
Label8: TLabel;
procedure ExitBtnClick(Sender: TObject);
procedure ProcessListDeletion(Sender: TObject; Node: TTreeNode);
procedure FormCreate(Sender: TObject);
procedure Panel2Resize(Sender: TObject);
procedure ProcessListChange(Sender: TObject; Node: TTreeNode);
procedure Button1Click(Sender: TObject);
procedure ThreadListDeletion(Sender: TObject; Item: TListItem);
procedure ThreadListChange(Sender: TObject; Item: TListItem;
Change: TItemChange);
procedure HeapListDeletion(Sender: TObject; Item: TListItem);
procedure HeapListChange(Sender: TObject; Item: TListItem;
Change: TItemChange);
procedure BlockListChange(Sender: TObject; Item: TListItem;
Change: TItemChange);
procedure BlockListDeletion(Sender: TObject; Item: TListItem);
private
{ Private declarations }
procedure UpdateProcessList;
procedure UpdateProcessParams;
procedure UpdateThreadList;
procedure UpdateThreadParams;
procedure UpdateHeapList;
procedure UpdateHeapParams;
procedure UpdateBlockList;
procedure UpdateBlockParams;
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure UpdateCaption( ALabel : TLabel; DefCaption : String; Count : Integer );
begin
if Count = 0 then ALabel.Caption := DefCaption
else ALabel.Caption := Format( '%s (%d)', [ DefCaption, Count ]);
end;

function ReturnName( Data : TProcessEntry32 ) : String;
var
i : Byte;
Names : string;

begin
Names := '';
i := 0;
while Data.szExeFile[ i ] <> '' do
begin
Names := Names + Data.szExeFile[ i ];
Inc( i );
end;
Result := Names;
end;

procedure TForm1.ExitBtnClick(Sender: TObject);
begin
Application.Terminate;
end;

procedure TForm1.UpdateProcessList;
var
Handler : THandle;
L : TList;
Data : TProcessEntry32;
i : Integer;

procedure AddRecord;
var Buf : PProcessEntry32;
begin
New( Buf );
Move( Data, Buf^, SizeOf( Data ));
L.Add( Buf );
end;

function ParentInList( R : TProcessEntry32 ) : Boolean;
var i : Integer;
begin
Result := False;
for i := 0 to L.Count - 1 do
if PProcessEntry32( L[ i ])^.th32ProcessID = R.th32ParentProcessID then
Result := True;
end;

procedure AddToTree( R : PProcessEntry32; ParentNode : TTreeNode );
begin
ProcessList.Items.AddChildObject( ParentNode,
ExtractFileName( ReturnName( R^ )), R );
L.Remove( R );
end;

function FindParentNode( R : PProcessEntry32 ) : TTreeNode;
var i : Integer;
begin
with ProcessList.Items do
for i := 0 to Count - 1 do
if PProcessEntry32( Item[ i ].Data )^.th32ProcessID =
R^.th32ParentProcessID then
begin
Result := Item[ i ];
Exit;
end;
Result := nil;
end;

begin
ProcessList.Items.BeginUpdate;
ProcessList.Items.Clear;
L := TList.Create;
Data.dwSize := SizeOf( Data );
Handler := CreateToolhelp32Snapshot( TH32CS_SNAPPROCESS, 0 );
try
if Process32First( Handler, Data ) then
begin
AddRecord;
while Process32Next( Handler, Data ) do
AddRecord;
end;
i := 0;
while i < L.Count do
begin
if ParentInList( PProcessEntry32( L[ i ])^) then Inc( i )
else
AddToTree( PProcessEntry32( L[ i ]), FindParentNode( PProcessEntry32( L[ i ])));
end;
while L.Count > 0 do
begin
i := 0;
while i < L.Count do
if ParentInList( PProcessEntry32( L[ i ])^) then Inc( i )
else
AddToTree( PProcessEntry32( L[ i ]), FindParentNode( PProcessEntry32( L[ i ])));
end;
finally
ProcessList.Items.EndUpdate;
L.Free;
CloseHandle( Handler );
end;
UpdateCaption( Label3, 'Processes', ProcessList.Items.Count );
ProcessList.FullExpand;
end;

procedure TForm1.ProcessListDeletion(Sender: TObject; Node: TTreeNode);
begin
Dispose( PProcessEntry32( Node.Data ));
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
UpdateProcessList;
end;

procedure TForm1.UpdateProcessParams;
var i : Integer;
begin
with ProcessParams.Items do
begin
for i := 0 to Count - 1 do
Item[ i ].SubItems.Clear;
if ProcessList.Selected <> nil then
with PProcessEntry32( ProcessList.Selected.Data )^ do
begin
Item[ 0 ].SubItems.Add( ExtractFilePath( ReturnName( PProcessEntry32( ProcessList.Selected.Data )^)));
Item[ 1 ].SubItems.Add( IntToStr( cntUsage ));
Item[ 2 ].SubItems.Add( IntToStr( th32ProcessID ));
Item[ 3 ].SubItems.Add( IntToStr( th32ParentProcessID ));
Item[ 4 ].SubItems.Add( IntToStr( cntThreads ));
Item[ 5 ].SubItems.Add( IntToStr( pcPriClassBase ));
end;
end;
end;

procedure TForm1.Panel2Resize(Sender: TObject);
begin
with ProcessParams do
Columns[ 1 ].Width := Width - Columns[ 0 ].Width - 5;
with ThreadParams do
Columns[ 1 ].Width := Width - Columns[ 0 ].Width - 5;
with HeapParams do
Columns[ 1 ].Width := Width - Columns[ 0 ].Width - 5;
with BlockParams do
Columns[ 1 ].Width := Width - Columns[ 0 ].Width - 5;
end;

procedure TForm1.UpdateThreadList;
var
Handler : THandle;
Entry : TThreadEntry32;
ProcID : Integer;

procedure AddRecord;
var Buf : PThreadEntry32;
begin
if Entry.th32OwnerProcessID = ProcID then
begin
New( Buf );
Move( Entry, Buf^, SizeOf( Entry ));
with ThreadList.Items.Add do
begin
Caption := IntToStr( Entry.th32ThreadID );
Data := Buf;
end;
end;
end;

begin
with ThreadList.Items do
begin
BeginUpdate;
Clear;
EndUpdate;
end;
if ProcessList.Selected <> nil then
begin
ProcID := PProcessEntry32( ProcessList.Selected.Data )^.th32ProcessID;
ThreadList.Items.BeginUpdate;
Entry.dwSize := SizeOf( Entry );
Handler := CreateToolhelp32Snapshot( TH32CS_SNAPTHREAD, ProcID );
try
if Thread32First( Handler, Entry ) then
begin
AddRecord;
while Thread32Next( Handler, Entry ) do
AddRecord;
end;
finally
ThreadList.Items.EndUpdate;
CloseHandle( Handler );
end;
end;
UpdateCaption( Label2, 'Process threads', ThreadList.Items.Count );
UpdateThreadParams;
end;

procedure TForm1.ProcessListChange(Sender: TObject; Node: TTreeNode);
begin
Screen.Cursor := crHourGlass;
Application.ProcessMessages;
try
UpdateProcessParams;
UpdateThreadList;
UpdateHeapList;
finally
Screen.Cursor := crDefault;
end;
end;

procedure TForm1.UpdateThreadParams;
var i : Integer;
begin
with ThreadParams.Items do
begin
for i := 0 to Count - 1 do
Item[ i ].SubItems.Clear;
if ThreadList.Selected <> nil then
with PThreadEntry32( ThreadList.Selected.Data )^ do
begin
Item[ 0 ].SubItems.Add( IntToStr( cntUsage ));
Item[ 1 ].SubItems.Add( IntToStr( tpBasePri ));
Item[ 2 ].SubItems.Add( IntToStr( tpDeltaPri ));
end;
end;
ThreadParams.Repaint;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Screen.Cursor := crHourGlass;
Application.ProcessMessages;
try
UpdateProcessList;
finally
Screen.Cursor := crDefault;
end;
end;

procedure TForm1.ThreadListDeletion(Sender: TObject; Item: TListItem);
begin
Dispose( PThreadEntry32( Item.Data ));
end;

procedure TForm1.ThreadListChange(Sender: TObject; Item: TListItem;
Change: TItemChange);
begin
UpdateThreadParams;
end;

procedure TForm1.UpdateHeapList;
var
Handler : THandle;
Entry : THeapList32;
ProcID : Integer;

procedure AddRecord;
var Buf : PHeapList32;
begin
if Entry.th32ProcessID = ProcID then
begin
New( Buf );
Move( Entry, Buf^, SizeOf( Entry ));
with HeapList.Items.Add do
begin
Caption := IntToStr( Entry.th32HeapID );
Data := Buf;
end;
end;
end;

begin
with HeapList.Items do
begin
BeginUpdate;
Clear;
EndUpdate;
end;
if ProcessList.Selected <> nil then
begin
ProcID := PProcessEntry32( ProcessList.Selected.Data )^.th32ProcessID;
HeapList.Items.BeginUpdate;
Entry.dwSize := SizeOf( Entry );
Handler := CreateToolhelp32Snapshot( TH32CS_SNAPHEAPLIST, ProcID );
try
if Heap32ListFirst( Handler, Entry ) then
begin
AddRecord;
while Heap32ListNext( Handler, Entry ) do
AddRecord;
end;
finally
HeapList.Items.EndUpdate;
CloseHandle( Handler );
end;
end;
UpdateCaption( Label5, 'Process heaps', HeapList.Items.Count );
UpdateHeapParams;
end;

procedure TForm1.HeapListDeletion(Sender: TObject; Item: TListItem);
begin
Dispose( PHeapList32( Item.Data ));
end;

procedure TForm1.HeapListChange(Sender: TObject; Item: TListItem;
Change: TItemChange);
begin
Screen.Cursor := crHourGlass;
Application.ProcessMessages;
try
UpdateHeapParams;
UpdateBlockList;
finally
Screen.Cursor := crDefault;
end;
end;

procedure TForm1.UpdateHeapParams;
var i : Integer;
const Words : array[ Boolean ] of String = ( 'NO', 'YES' );
begin
with HeapParams.Items do
begin
for i := 0 to Count - 1 do
Item[ i ].SubItems.Clear;
if HeapList.Selected <> nil then
with PHeapList32( HeapList.Selected.Data )^ do
begin
Item[ 0 ].SubItems.Add( Words[( dwFlags and HF32_DEFAULT ) <> 0 ]);
Item[ 1 ].SubItems.Add( Words[( dwFlags and HF32_SHARED ) <> 0 ]);
end;
end;
HeapParams.Repaint;
end;

procedure TForm1.UpdateBlockList;
var
Entry : THeapEntry32;
ProcID, HeapID : Integer;

procedure AddRecord;
var Buf : PHeapEntry32;
begin
if ( Entry.th32ProcessID = ProcID ) and
( Entry.th32HeapID = HeapID ) then
begin
New( Buf );
Move( Entry, Buf^, SizeOf( Entry ));
with BlockList.Items.Add do
begin
Caption := IntToStr( Entry.hHandle );
Data := Buf;
end;
end;
end;

begin
with BlockList.Items do
begin
BeginUpdate;
Clear;
EndUpdate;
end;
if ( ProcessList.Selected <> nil ) and ( HeapList.Selected <> nil ) then
begin
ProcID := PProcessEntry32( ProcessList.Selected.Data )^.th32ProcessID;
HeapID := PHeapList32( HeapList.Selected.Data )^.th32HeapID;
BlockList.Items.BeginUpdate;
try
Entry.dwSize := SizeOf( Entry );
if Heap32First( Entry, ProcID, HeapID ) then
begin
AddRecord;
while Heap32Next( Entry ) do
AddRecord;
end;
finally
BlockList.Items.EndUpdate;
end;
end;
UpdateCaption( Label7, 'Heap blocks', BlockList.Items.Count );
UpdateBlockParams;
end;

procedure TForm1.UpdateBlockParams;
var i : Integer;
function GetBlockFlagName( Flags : Integer ) : String;
begin
case Flags of
LF32_FIXED : Result := 'FIXED';
LF32_MOVEABLE : Result := 'MOVEABLE';
LF32_FREE : Result := 'FREE';
else
Result := Format( '%X', [ Flags ]);
end;
end;
begin
with BlockParams.Items do
begin
for i := 0 to Count - 1 do
Item[ i ].SubItems.Clear;
if BlockList.Selected <> nil then
with PHeapEntry32( BlockList.Selected.Data )^ do
begin
Item[ 0 ].SubItems.Add( IntToStr( dwBlockSize ));
Item[ 1 ].SubItems.Add( Format( '%X', [ dwAddress ]));
Item[ 2 ].SubItems.Add( GetBlockFlagName( dwFlags ));
end;
end;
BlockParams.Repaint;
end;

procedure TForm1.BlockListChange(Sender: TObject; Item: TListItem;
Change: TItemChange);
begin
if Change = ctState then UpdateBlockParams;
end;

procedure TForm1.BlockListDeletion(Sender: TObject; Item: TListItem);
begin
Dispose( PHeapEntry32( Item.Data ));
end;










end.
 
谢谢!! 我回去试试!!
 
后退
顶部