w9xinfo.pas

《Delphi开发人员指南》配书原码

unit W9xInfo;

interface

uses Windows, InfoInt, Classes, TlHelp32, Controls, ComCtrls;

type
  TWin9xInfo = class(TInterfacedObject, IWin32Info)
  private
    FProcList: TList;
    FWinIcon: HICON;
    FSnap: THandle;
    procedure Refresh;
  public
    constructor Create;
    destructor Destroy; override;
    procedure FillProcessInfoList(ListView: TListView; ImageList: TImageList);
    procedure ShowProcessProperties(Cookie: Pointer);
  end;

implementation

uses ShellAPI, CommCtrl, SysUtils, Detail9x;

const
  ProcessInfoCaptions: array[0..3] of string = (
    'ProcessName', 'Threads', 'ID', 'ParentID');

{ TProcList }

type
  TProcList = class(TList)
    procedure Clear; override;
  end;

procedure TProcList.Clear;
var
  I: Integer;
begin
  for I := 0 to Count - 1 do Dispose(PProcessEntry32(Items[I]));
  inherited Clear;
end;

{ TWin95Info }

constructor TWin9xInfo.Create;
begin
  FProcList := TProcList.Create;
  FWinIcon := LoadImage(0, IDI_WINLOGO, IMAGE_ICON, LR_DEFAULTSIZE,
    LR_DEFAULTSIZE, LR_DEFAULTSIZE or LR_DEFAULTCOLOR or LR_SHARED);
end;

destructor TWin9xInfo.Destroy;
begin
  DestroyIcon(FWinIcon);
  if FSnap > 0 then CloseHandle(FSnap);
  FProcList.Free;
  inherited Destroy;
end;

procedure TWin9xInfo.FillProcessInfoList(ListView: TListView;
  ImageList: TImageList);
var
  I: Integer;
  ExeFile: string;
  PE: TProcessEntry32;
  HAppIcon: HIcon;
begin
  Refresh;
  ListView.Columns.Clear;
  ListView.Items.Clear;
  for I := Low(ProcessInfoCaptions) to High(ProcessInfoCaptions) do
    with ListView.Columns.Add do
    begin
      if I = 0 then Width := 285
      else Width := 75;
      Caption := ProcessInfoCaptions[I];
    end;
  for I := 0 to FProcList.Count - 1 do
  begin
    PE := PProcessEntry32(FProcList.Items[I])^;
    HAppIcon := ExtractIcon(HInstance, PE.szExeFile, 0);
    try
      if HAppIcon = 0 then HAppIcon := FWinIcon;
      ExeFile := PE.szExeFile;
      if ListView.ViewStyle = vsList then
        ExeFile := ExtractFileName(ExeFile);
      // insert new item, set its caption, add subitems
      with ListView.Items.Add, SubItems do
      begin
        Caption := ExeFile;
        Data := FProcList.Items[I];
        Add(IntToStr(PE.cntThreads));
        Add(IntToHex(PE.th32ProcessID, 8));
        Add(IntToHex(PE.th32ParentProcessID, 8));
        if ImageList <> nil then
          ImageIndex := ImageList_AddIcon(ImageList.Handle, HAppIcon);
      end;
    finally
      if HAppIcon <> FWinIcon then DestroyIcon(HAppIcon);
    end;
  end;
end;

procedure TWin9xInfo.Refresh;
var
  PE: TProcessEntry32;
  PPE: PProcessEntry32;
begin
  FProcList.Clear;
  if FSnap > 0 then CloseHandle(FSnap);
  FSnap := CreateToolHelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  if FSnap = INVALID_HANDLE_VALUE then
    raise Exception.Create('CreateToolHelp32Snapshot failed');
  PE.dwSize := SizeOf(PE);
  if Process32First(FSnap, PE) then               // get process
    repeat
      New(PPE);                                  // create new PPE
      PPE^ := PE;                                // fill it
      FProcList.Add(PPE);                        // add it to list
    until not Process32Next(FSnap, PE);           // get next process
end;

procedure TWin9xInfo.ShowProcessProperties(Cookie: Pointer);
begin
  ShowProcessDetails(PProcessEntry32(Cookie));
end;

end.