用CreateToolHelp32Snapshot 查看进程及其模块列表(delphi xe2)

     原文出处：http://blog.csdn.net/htiscold/article/details/3962817

    在delphi xe2下调试运行成功。

 

代码：

 

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, TLHelp32, Vcl.ComCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    ListView1: TListView;
    ListView2: TListView;
    ListBox1: TListBox;
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure ListView1DblClick(Sender: TObject);
  private
    { Private declarations }
  public
    procedure getmodulelist(pid: integer);

    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

function AdjustProcessPrivilege(Processhandle: Thandle;
  Token_Name: pchar): boolean;
var
  // Token:cardinal;
  Token:ULONG_PTR;
  TokenPri: _TOKEN_PRIVILEGES;
  processDest: int64;
  i: DWORD;
begin
  Result := false;
  if OpenProcessToken(Processhandle, TOKEN_ADJUST_PRIVILEGES, Token) then
  begin
    if LookupPrivilegeValue(nil, Token_Name, processDest) then
    begin
      TokenPri.PrivilegeCount := 1;
      TokenPri.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
      TokenPri.Privileges[0].Luid := processDest;
      i := 0;
      if AdjustTokenPrivileges(Token, false, TokenPri, sizeof(TokenPri), nil, i)
      then
        Result := true;
    end;
  end;
end;

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  th32handle: Thandle;
  procstruct: TProcessEntry32;
  pid: string;
  finded: boolean;
  proname: string;
  mdfn: array [0 .. 255] of char;
begin
  // 列出所有进程
  th32handle := CreateToolHelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  try
    procstruct.dwSize := sizeof(procstruct);
    ListView1.Clear;
    finded := Process32First(th32handle, procstruct);
    while finded do
    begin
      proname := String(procstruct.szExeFile);
      pid := inttostr(procstruct.th32ProcessID);

      with ListView1.Items.Add do
      begin
        Caption := pid;
        SubItems.Add(proname);

        // SubItems.Add('');
      end;

      listBox1.Items.Add(pid+'  --  '+proname);
      // CloseHandle(hproc);
      finded := Process32Next(th32handle, procstruct);
    end;
  finally
    CloseHandle(th32handle);
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  getmodulelist(0); // 可以先试下得到当前进程的模块列表
end;

procedure TForm1.getmodulelist(pid: integer);
var
  th32handle: Thandle;
  procstruct: TModuleEntry32;
  finded: boolean;
begin
  th32handle := CreateToolHelp32Snapshot(TH32CS_SNAPMODULE, pid);
  try
    procstruct.dwSize := sizeof(procstruct);
    ListView2.Clear;
    finded := Module32First(th32handle, procstruct);
    while finded do
    begin
      with ListView2.Items.Add do
      begin
        Caption := inttostr(procstruct.th32ProcessID);
        SubItems.Add(inttostr(procstruct.th32ModuleID));

        SubItems.Add(inttostr(procstruct.hModule));
        SubItems.Add(procstruct.szModule);
        SubItems.Add(procstruct.szExePath);
      end;

      finded := Module32Next(th32handle, procstruct);
    end;
  finally
    CloseHandle(th32handle);
  end;
end;

procedure TForm1.ListView1DblClick(Sender: TObject);
begin
  getmodulelist(strtoint(ListView1.Selected.Caption));
end;


procedure TForm1.FormCreate(Sender: TObject);
begin
  AdjustProcessPrivilege(GetCurrentProcess, 'SeDebugPrivilege');
  // 要先提升至系统权限才能查看其它进程的信息
end;

end.