列举进程的问题

Question

参照下面这段程序
type TForm1 = class(TForm)
...
end;var
Form1: TForm1;
l : Tlist; ////返回的东东在"L"这个TList中。type
TProcessInfo = Record
ExeFile : String;
ProcessID : DWORD;
end;
pProcessInfo = ^TProcessInfo;implementation{$R *.DFM}procedure TForm1.FormCreate(Sender: TObject);
var p : pProcessInfo;
i : integer;
ContinueLoop:BOOL;
var
FSnapshotHandle:THandle;
FProcessEntry32:TProcessEntry32;
begin
l := TList.Create;
l.Clear;
FSnapshotHandle:=CreateToolhelp32Snapshot(TH32CS_SNAPPROCES
S,0);
FProcessEntry32.dwSize:=Sizeof(FProcessEntry32);
ContinueLoop:=Process32First(FSnapshotHandle,FProcessEntry3
2);
while integer(ContinueLoop)<>0 do
begin
New(p);
p.ExeFile := FProcessEntry32.szExeFile;
p.ProcessID := FProcessEntry32.th32ProcessID;
l.Add(p);
ContinueLoop:=Process32Next(FSnapshotHandle,FProcessEntry32
);
end;
end;procedure TForm1.FormDestroy(Sender: TObject);
var p : pProcessInfo;
i : integer;
begin
With l do
for i := Count - 1 DownTo 0 do
begin p := items[i]; Dispose(p); Delete(i); end;
end;...
end. 

Answer 1

    这个程序我已经有了，但是我对CreateToolhelp32Snapshot这个函数不大放心，怕哪天系统给去掉了，所以没有敢用。谢谢。

Answer 2

{
***********************************************
*    RUNNINGPROCS, version 1.0 (freeware)     *
***********************************************
*  Created by Israel Gómez de Celis González  *
*  http://pagina.de/sparkie (spanish only)    *
*  [email protected]                             *
***********************************************
* VLC Component for system processes          *
* management.                                 *
***********************************************PROPERTIES:    Enabled (boolean):
       Component status. When True the component obtains information
       about current running processes.    Count (integer):
       Total number of running processes.    ProcessList (array of TProcessEntry32):
       The array where the processes information is stored.
       It can store a maximum of 100 entries.        dwSize:              Process size
        cntUsage:            unknown
        th32ProcessID:       Process ID
        th32DefaultHeapID:   unknown
        th32ModuleID:        Module ID
        cntThreads:          Number of threads in process
        th32ParentProcessID: Parent process ID
        pcPriClassBase:      Process priority: 4 (low) to 24 (real time)
        dwFlags:             unknown
        szExeFile:           Process path and filename
METHODS:    GetProcessDescriptionByPos(index: integer): string    GetProcessDescriptionByID(PID: integer): string    TerminateProcessByPos(index: integer): boolean    TerminateProcessByID(PID: integer): boolean    KillProcessByPos(index: integer): boolean    KillProcessByID(PID: integer): boolean    KillParentByPos(index: integer): boolean    KillParentByID(PID: integer): boolean
EVENTS:    OnCreatedProcess (TNotifyEvent):    OnTerminatedProcess (TNotifyEvent):
}unit RunningProcs;interfaceuses
  Windows, Messages, SysUtils, Classes, Controls, Forms, ExtCtrls, TLHelp32;type  TRunningProcs = class(TComponent)
  private
    FEnabled: boolean;
    FCount: integer;
    FOnCreatedProcess: TNotifyEvent;
    FOnTerminatedProcess: TNotifyEvent;
    FTimer: TTimer;
    procedure SetEnabled(Value: boolean);
    procedure FUpdateProcessList(Sender: TObject);
  public
    ProcessList: array [1..100] of TProcessEntry32;
    constructor Create(AOwner:TComponent); override;
    destructor Destroy; override;
    function GetProcessDescriptionByID(PID: integer): string;
    function GetProcessDescriptionByPos(index: integer): string;
    function TerminateProcessByID(PID: integer): boolean;
    function TerminateProcessByPos(index: integer): boolean;
    function KillProcessByID(PID: integer): boolean;
    function KillProcessByPos(index: integer): boolean;
    function KillParentByID(PID: integer): boolean;
    function KillParentByPos(index: integer): boolean;
    property Enabled: boolean read FEnabled write SetEnabled default False;
    property Count: integer read FCount;
  published
    property OnCreatedProcess: TNotifyEvent read FOnCreatedProcess write FOnCreatedProcess;
    property OnTerminatedProcess: TNotifyEvent read FOnTerminatedProcess write FOnTerminatedProcess;
  end;procedure Register;implementationprocedure Register;
begin
  RegisterComponents('System', [TRunningProcs]);
end;function TerminateAppEnum(Handle: THandle; Lparam: integer): boolean; stdcall;
var
  ID: integer;
begin
  GetWindowThreadProcessID(Handle,@ID);
  if ID = Lparam then
  begin
    BringWindowToTop(Handle);
    PostMessage(Handle,WM_CLOSE,0,0);
  end;
  Result := True;
end;constructor TRunningProcs.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FCount := 0;
  FTimer := TTimer.Create(Self);
  FTimer.Enabled := False;
  FTimer.Interval := 100;
  FTimer.OnTimer := FUpdateProcessList;
end;destructor TRunningProcs.Destroy;
begin
  FTimer.Enabled := False;
  FTimer.OnTimer := nil;
  FTimer.Free;
  inherited Destroy;
end;procedure TRunningProcs.SetEnabled(Value: boolean);
begin
  FEnabled := Value;
  FTimer.Enabled := FEnabled;
end;procedure TRunningProcs.FUpdateProcessList(Sender: TObject);
var
  Data: TProcessEntry32;
  Handler: THandle;
  i, j: integer;  procedure NewEntry;
  var
    Buf: PProcessEntry32;
  begin
    New(Buf);
    Move(Data, Buf^, SizeOf(Data));
  end;begin
  Data.dwSize := SizeOf(Data);
  Handler := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  try
    i := 1;
    if Process32First(Handler, Data) then
    begin
      ProcessList[i] := Data;
      i := i + 1;
      NewEntry;
      while ((Process32Next(Handler, Data)) and (i <= 100)) do
      begin
        ProcessList[i] := Data;
        i := i + 1;
        NewEntry;
      end;
    end;
  finally
    CloseHandle(Handler);
    if i < 100 then for j := i to 100 do
    begin
      ProcessList[j].dwSize := 0;
      ProcessList[j].cntUsage := 0;
      ProcessList[j].th32ProcessID := 0;
      ProcessList[j].th32DefaultHeapID := 0;
      ProcessList[j].th32ModuleID := 0;
      ProcessList[j].cntThreads := 0;
      ProcessList[j].th32ParentProcessID := 0;
      ProcessList[j].pcPriClassBase := 0;
      ProcessList[j].dwFlags := 0;
      ProcessList[j].szExeFile := '';
    end;
  end;
  i := i - 1;
  if i > FCount then
  begin
    FCount := i;
    if Assigned(FOnCreatedProcess) then FOnCreatedProcess(Self);
  end
  else if i < FCount then
  begin
   FCount := i;
   if Assigned(FOnTerminatedProcess) then FOnTerminatedProcess(Self);
  end
  else FCount := i;
end;function TRunningProcs.GetProcessDescriptionByID(PID: integer): string;
var
  i: integer;
  index: integer;
  VerSize: integer;
  VerBuf: PChar;
  VerBufValue: pointer;
  {$IFDEF Delphi3Below}
  VerHandle: integer;
  VerBufLen: integer;
  {$ELSE}
  VerHandle: cardinal;
  VerBufLen: cardinal;
  {$ENDIF}
  VerKey: string;  function GetInfo(ThisKey: string): string;
  begin
    Result := '';
    VerKey := '\StringFileInfo\' + IntToHex(loword(integer(VerBufValue^)), 4) +
    IntToHex(hiword(integer(VerBufValue^)), 4) + '\' + ThisKey;
    if VerQueryValue(VerBuf, PChar(VerKey), VerBufValue, DWORD(VerBufLen)) then
      Result := StrPas(VerBufValue);
  end;  function QueryValue(ThisValue: string): string;
  begin
    Result := '';
    if GetFileVersionInfo(ProcessList[index].szExeFile, VerHandle, VerSize, VerBuf) and
      VerQueryValue(VerBuf, '\VarFileInfo\Translation', VerBufValue, DWORD(VerBufLen)) then
      Result := GetInfo(ThisValue);
  end;begin
  index := 0;
  for i := 1 to 100 do
    if ProcessList[i].th32ProcessID = PID then index := i;
  if index = 0 then
  begin
    Result := '';
    Exit;
  end;
  VerSize := GetFileVersionInfoSize(ProcessList[index].szExeFile, DWORD(VerHandle));
  VerBuf := AllocMem(VerSize);
  try
    Result := QueryValue('FileDescription');
  finally
    FreeMem(VerBuf, VerSize);
  end;
end;function TRunningProcs.GetProcessDescriptionByPos(index: integer): string;
var
  VerSize: integer;
  VerBuf: PChar;
  VerBufValue: pointer;
  {$IFDEF Delphi3Below}
  VerHandle: integer;
  VerBufLen: integer;
  {$ELSE}
  VerHandle: cardinal;
  VerBufLen: cardinal;
  {$ENDIF}
  VerKey: string;  function GetInfo(ThisKey: string): string;
  begin
    Result := '';
    VerKey := '\StringFileInfo\' + IntToHex(loword(integer(VerBufValue^)), 4) +
    IntToHex(hiword(integer(VerBufValue^)), 4) + '\' + ThisKey;
    if VerQueryValue(VerBuf, PChar(VerKey), VerBufValue, DWORD(VerBufLen)) then
      Result := StrPas(VerBufValue);
  end;  function QueryValue(ThisValue: string): string;
  begin
    Result := '';
    if GetFileVersionInfo(ProcessList[index].szExeFile, VerHandle, VerSize, VerBuf) and
      VerQueryValue(VerBuf, '\VarFileInfo\Translation', VerBufValue, DWORD(VerBufLen)) then
      Result := GetInfo(ThisValue);
  end;begin
  VerSize := GetFileVersionInfoSize(ProcessList[index].szExeFile, DWORD(VerHandle));
  VerBuf := AllocMem(VerSize);
  try
    Result := QueryValue('FileDescription');
  finally
    FreeMem(VerBuf, VerSize);
  end;
end;function TRunningProcs.TerminateProcessByID(PID: integer): boolean;
var
  hProc: THandle;
begin
  hProc := OpenProcess(SYNCHRONIZE or PROCESS_TERMINATE, False, PID);
  if hProc = 0 then
    Result := False
  else
    begin
      EnumWindows(@TerminateAppEnum, PID);
      if WaitForSingleObject(hProc,5000) = WAIT_OBJECT_0 then Result := True else Result := False;
    end;
  CloseHandle(hProc);
  if Result = True then
  begin
    FUpdateProcessList(Self);
    if Assigned(FOnTerminatedProcess) then FOnTerminatedProcess(Self);
  end;
end;function TRunningProcs.TerminateProcessByPos(index: integer): boolean;
var
  hProc: THandle;
begin
  if (index < 1) or (index > 100) then
  begin
    Result := False;
    Exit;
  end;
  hProc := OpenProcess(SYNCHRONIZE or PROCESS_TERMINATE, False, ProcessList[index].th32ProcessID);
  if hProc = 0 then
    Result := False
  else
    begin
      EnumWindows(@TerminateAppEnum, ProcessList[index].th32ProcessID);
      if WaitForSingleObject(hProc,5000) = WAIT_OBJECT_0 then Result := True else Result := False;
    end;
  CloseHandle(hProc);
  if Result = True then
  begin
    FUpdateProcessList(Self);
    if Assigned(FOnTerminatedProcess) then FOnTerminatedProcess(Self);
  end;
end;function TRunningProcs.KillProcessByID(PID: integer): boolean;
var
  hProc: THandle;
begin
  hProc := OpenProcess(SYNCHRONIZE or PROCESS_TERMINATE, False, PID);
  if hProc = 0 then
    Result := False
  else
    if TerminateProcess(hProc, 0) then Result := True else Result := False;
  CloseHandle(hProc);
  if Result = True then
  begin
    FUpdateProcessList(Self);
    if Assigned(FOnTerminatedProcess) then FOnTerminatedProcess(Self);
  end;
end;function TRunningProcs.KillProcessByPos(index: integer): boolean;
var
  hProc: THandle;
begin
  if (index < 1) or (index > 100) then
  begin
    Result := False;
    Exit;
  end;
  hProc := OpenProcess(SYNCHRONIZE or PROCESS_TERMINATE, False, ProcessList[index].th32ProcessID);
  if hProc = 0 then
    Result := False
  else
    if TerminateProcess(hProc, 0) then Result := True else Result := False;
  CloseHandle(hProc);
  if Result = True then
  begin
    FUpdateProcessList(Self);
    if Assigned(FOnTerminatedProcess) then FOnTerminatedProcess(Self);
  end;
end;function TRunningProcs.KillParentByID(PID: integer): boolean;
var
  hProc: THandle;
  i, index: integer;
begin
  index := 0;
  for i := 1 to 100 do
    if ProcessList[i].th32ProcessID = PID then index := i;
  if index = 0 then
  begin
    Result := False;
    Exit;
  end;
  hProc := OpenProcess(SYNCHRONIZE or PROCESS_TERMINATE, False, index);
  if hProc = 0 then
    Result := False
  else
    if TerminateProcess(hProc, 0) then Result := True else Result := False;
  CloseHandle(hProc);
  if Result = True then
  begin
    FUpdateProcessList(Self);
    if Assigned(FOnTerminatedProcess) then FOnTerminatedProcess(Self);
  end;
end;function TRunningProcs.KillParentByPos(index: integer): boolean;
var
  hProc: THandle;
begin
  if (index < 1) or (index > 100) then
  begin
    Result := False;
    Exit;
  end;
  hProc := OpenProcess(SYNCHRONIZE or PROCESS_TERMINATE, False, ProcessList[index].th32ParentProcessID);
  if hProc = 0 then
    Result := False
  else
    if TerminateProcess(hProc, 0) then Result := True else Result := False;
  CloseHandle(hProc);
  if Result = True then
  begin
    FUpdateProcessList(Self);
    if Assigned(FOnTerminatedProcess) then FOnTerminatedProcess(Self);
  end;
end;end.