在DLL过程中使用Process32First / Next

时间：2013-08-27 19:32:58

标签： delphi winapi dll

我有以下程序：

procedure MyMainThread.MapProc;
var
  Handle: THandle;
  PID: dword;
  Struct: TProcessEntry32;
  Processes: TStringList;
begin
  Handle:= CreateToolHelp32SnapShot(TH32CS_SNAPPROCESS, 0);
  Struct.dwSize:=Sizeof(TProcessEntry32);
  Process32First(Handle, Struct);
  Processes:= TStringList.Create;
  repeat
    Processes.Add(Struct.szExeFile);
    Processes.SaveToFile('C:\Log.txt');
    PID:= Struct.th32ProcessID;
    PIDHandle:= OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_OPERATION or
      PROCESS_VM_READ, false, PID);
    CloseHandle(PIDHandle);
  until (not Process32Next(Handle,Struct));
  Processes.Free;
end;

正如您所看到的，我将正在运行的进程保存在C：\ Log.txt中，这在.exe文件中很有用。现在我正在尝试在.DLL文件中实现它，概念是：DLL将被加载，它将有一个EntryPoint调用Thread.Create ...这个Thread将使用SetTimer来运行MapProc的过程每10秒钟在C：\ Log.txt中保存正在运行的进程。代码是：

library Project1;

uses
  Windows,
  SysUtils,
  Classes,
  Registry,
  EncdDecd,
  TLHelp32,
  IdHTTP;

{$R *.res}
type
  MyMainThread = Class(TThread)
  var
    DestDir, ContactHost: String;
    Sent: TStringList;
    PIDHandle: THandle; //need to be public because we use in MapProc / CatchYa
  private
    procedure MapProc;
    procedure MapMemory(ProcessName: string);
    procedure CreateMessagePump;
  protected
    constructor Create;
    procedure Execute; override;
  end;

constructor MyMainThread.Create;
begin
  inherited Create(false);
  FreeOnTerminate:= true;
  Priority:= tpNormal;
end;

procedure MyMainThread.Execute;
begin
  while not Terminated do
    begin
      SetTimer(0, 0, 10000, @MyMainThread.MapProc); //setting timer 10 seconds calling MapProc
      CreateMessagePump; //we are inside DLL so I think we need Message Pump to timer work
      Terminate;
    end;
end;


procedure MyMainThread.MapProc;
var
  Handle: THandle;
  PID: dword;
  Struct: TProcessEntry32;
  Processes: TStringList;
begin
  Handle:= CreateToolHelp32SnapShot(TH32CS_SNAPPROCESS, 0);
  Struct.dwSize:=Sizeof(TProcessEntry32);
  Process32First(Handle, Struct);
  Processes:= TStringList.Create;
  repeat
    Processes.Add(Struct.szExeFile);
    Processes.SaveToFile('C:\Log.txt');
    PID:= Struct.th32ProcessID;
    PIDHandle:= OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_OPERATION or
      PROCESS_VM_READ, false, PID);
    if POS(Struct.szExeFile, ExeName) = 0 then
      MapMemory(Struct.szExeFile); //procedure called for verification purposes, but it's not even getting called
    CloseHandle(PIDHandle);
  until (not Process32Next(Handle,Struct));
  Processes.Free;
end;


procedure MyMainThread.CreateMessagePump;
var
  AppMsg: TMsg;
begin
  while GetMessage(AppMsg, 0, 0, 0) do
    begin
      TranslateMessage(AppMsg);
      DispatchMessage(AppMsg);
    end;
  //if needed to quit this procedure use PostQuitMessage(0);
end;


procedure EntryPoint(Reason: integer);
begin
  if Reason = DLL_PROCESS_ATTACH then
    begin
      MyMainThread.Create;
    end
  else
  if Reason = DLL_PROCESS_DETACH then
    begin
      MessageBox(0, 'DLL De-Injected', 'DLL De-Injected', 0);
    end;
end;

begin
  DLLProc:= @EntryPoint;
  EntryPoint(DLL_PROCESS_ATTACH);
end.

但是在运行时，我只在Log.txt文件中输入以下行：[System Process]

exe托管DLL是：

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;


implementation

{$R *.dfm}



procedure TForm1.Button1Click(Sender: TObject);
var
  HD: THandle;
begin
  HD:= LoadLibrary('C:\Project1.dll');
end;

end.

2 个答案:

答案 0 :(得分：5)

您的代码失败的原因是您没有对SetTimer函数使用正确的回调。根据{{​​3}}应该有像

这样的签名 
procedure (hwnd: HWND; uMsg: UINT; idEvent: UINT_PTR; dwTime: DWORD); stdcall;

您的不兼容回调 - 这是一个类方法 - 会导致代码认为Self位于完全任意的内存地址，因为类方法具有隐式Self参数，但winapi不知道这一点。现在，当代码尝试写入无效地址 - 'PIDHandle'时，假设应该有一个类字段，则引发AV，并且由于未处理异常，其余代码不会被执行 - 同样如David的回答中所述

您的解决方案是使用正确的回调。要访问类成员，您可以使用全局变量。不使用全局变量需要一些hacky代码（google for MethodToProcedure f.i。）

样本可能如下：

threadvar
  MyThread: MyMainThread;

procedure TimerProc(hwnd: HWND; uMsg: UINT; idEvent: UINT_PTR; dwTime: DWORD);
  stdcall;
var
  Handle: THandle;
  PID: dword;
  Struct: TProcessEntry32;
  Processes: TStringList;
begin
  Handle:= CreateToolHelp32SnapShot(TH32CS_SNAPPROCESS, 0);
  Struct.dwSize:=Sizeof(TProcessEntry32);
  Process32First(Handle, Struct);
  Processes:= TStringList.Create;
  repeat
    Processes.Add(Struct.szExeFile);
    Processes.SaveToFile('C:\Temp\Log3.txt');
    PID:= Struct.th32ProcessID;
    MyThread.PIDHandle:= OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_OPERATION or
      PROCESS_VM_READ, false, PID);
    if POS(Struct.szExeFile, ExeName) = 0 then
      MyThread.MapMemory(Struct.szExeFile);
    CloseHandle(MyThread.PIDHandle);
  until (not Process32Next(Handle,Struct));
  Processes.Free;
end;

procedure MyMainThread.Execute;
begin
  while not Terminated do
    begin
      MyThread := Self;
      SetTimer(0, 0, 10000, @TimerProc);
      CreateMessagePump;
      Terminate;
    end;
end;

要接受David的建议，不要被'@'运算符打败，我们应该首先重新声明SetTimer函数以正确使用回调。这看起来像是：

threadvar
  MyThread: MyMainThread;

procedure TimerProc(hwnd: HWND; uMsg: UINT; idEvent: UINT_PTR; dwTime: DWORD);
  stdcall;
var
  ..
begin
  ..
end;

type
  TFnTimerProc = procedure (hwnd: HWND; uMsg: UINT; idEvent: UIntPtr;
      dwTime: DWORD); stdcall;

function SetTimer(hWnd: HWND; nIDEvent: UIntPtr; uElapse: UINT;
  lpTimerFunc: TFNTimerProc): UINT; stdcall; external user32;

procedure MyMainThread.Execute;
begin
  MyThread := Self;
  SetTimer(0, 0, 10000, TimerProc);
  CreateMessagePump;
end;

答案 1 :(得分：2)

这是一个按照您的期望工作的版本。这证明使用toolhelp32的进程枚举可以很好地从DLL中运行。

<强>库 

library ProcessEnumLib;

uses
  SysUtils, Classes, Windows, TlHelp32;

type
  TMyThread = class(TThread)
  protected
    procedure Execute; override;
  end;

procedure TMyThread.Execute;
var
  Handle: THandle;
  PID: dword;
  ProcessEntry: TProcessEntry32;
  Processes: TStringList;
begin
  Handle := CreateToolHelp32SnapShot(TH32CS_SNAPPROCESS, 0);
  Win32Check(Handle<>0);
  try
    ProcessEntry.dwSize := Sizeof(TProcessEntry32);
    Win32Check(Process32First(Handle, ProcessEntry));
    Processes := TStringList.Create;
    try
      repeat
        Processes.Add(ProcessEntry.szExeFile);
      until not Process32Next(Handle, ProcessEntry);
      Processes.SaveToFile('C:\Desktop\Log.txt');
    finally
      Processes.Free;
    end;
  finally
    CloseHandle(Handle);
  end;
end;

begin
  TMyThread.Create;
end.

<强>主机 

program ProcessEnumHost;

{$APPTYPE CONSOLE}

uses
  Windows;

begin
  LoadLibrary('ProcessEnumLib.dll');
  Sleep(1000);
end.

您的版本失败，因为对OpenProcess的调用引发了访问冲突，导致线程被终止。现在，我不确定为什么会这样。

我建议你严格简化。您不需要消息循环，也不需要计时器。您可以在线程中使用Sleep在流程图之间暂停。像这样：

library ProcessEnumLib;

uses
  SysUtils, Classes, Windows, TlHelp32;

type
  TMyThread = class(TThread)
  protected
    procedure Execute; override;
  end;

procedure TMyThread.Execute;
var
  Handle, ProcessHandle: THandle;
  ProcessEntry: TProcessEntry32;
  Processes: TStringList;
begin
  while True do
  begin
    Handle := CreateToolHelp32SnapShot(TH32CS_SNAPPROCESS, 0);
    Win32Check(Handle<>0);
    try
      ProcessEntry.dwSize := Sizeof(TProcessEntry32);
      Win32Check(Process32First(Handle, ProcessEntry));
      Processes := TStringList.Create;
      try
        repeat
          Processes.Add(ProcessEntry.szExeFile);
          ProcessHandle := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_OPERATION or PROCESS_VM_READ, false, ProcessEntry.th32ProcessID);
          CloseHandle(ProcessHandle);
        until not Process32Next(Handle, ProcessEntry);
        Processes.SaveToFile('C:\Desktop\Log.txt');
      finally
        Processes.Free;
      end;
    finally
      CloseHandle(Handle);
    end;

    Sleep(10000);//10s sleep
  end;
end;

begin
  TMyThread.Create;
end.

我不知道为什么，但这种变体在调用OpenProcess时避免使用AV。我很想知道为什么。但这是你做你想做的事情的正确方法，它会解决问题。

相关问题
最新问题