Delphi 在DLL过程中使用Process32First/Next

我有以下程序：

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将被加载，它将有一个调用线程的入口点。创建。。。此线程将使用SetTimer每10秒运行一次过程MapProc，以将正在运行的进程保存在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文件中只看到一行：[系统进程]

托管DLL的exe是：

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.

---

这里有一个版本，正如你所期待的。这证明了使用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.

您的版本失败，因为对

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.

库进程enumlib；
使用
SysUtils、类、窗口、TlHelp32；
类型
TMyThread=class（TThread）
受保护的
程序执行；推翻
终止
程序TMyThread.Execute；
变量
句柄，进程句柄：THandle；
ProcessEntry:TProcessEntry32；
过程：TStringList；
开始
尽管如此
开始
句柄：=CreateToolHelp32SnapShot（TH32CS\u SNAPPROCESS，0）；
Win32Check（Handle0）；
尝试
ProcessEntry.dwSize:=Sizeof（tprocescentry32）；
Win32Check（Process32First（Handle，ProcessEntry））；
进程：=TStringList.Create；
尝试
重复
processs.Add（ProcessEntry.szExeFile）；
ProcessHandle:=OpenProcess（进程\查询\信息或进程\虚拟机\操作或进程\虚拟机\读取，false，ProcessEntry.th32ProcessID）；
关闭手柄（ProcessHandle）；
直到不是Process32Next（Handle，ProcessEntry）；
processs.SaveToFile（'C:\Desktop\Log.txt'）；
最后
流程。免费；
终止
最后
关闭手柄（手柄）；
终止
睡眠（10000）//10秒睡眠
终止
终止
开始
TMyThread.Create；
终止

---

我不知道为什么，但是这个变体在调用

OpenProcess

时避免了AV。我很想知道为什么。但是这是你想做什么就做什么的正确方法，它回避了问题。

你的代码失败的原因是你没有对

SetTimer

函数使用正确的回调。根据，应该有一个签名，如

procedure (hwnd: HWND; uMsg: UINT; idEvent: UINT_PTR; dwTime: DWORD); stdcall;

您的不兼容回调（是一个类方法）导致代码认为

Self

位于完全任意的内存地址，因为类方法有一个隐式Self参数，但winapi对此一无所知。现在，当代码试图写入一个无效的地址“PIDHandle”时，假设应该有一个类字段，则会引发一个AV，并且由于未处理异常，因此不会执行代码的其余部分-也如David的回答中所述

您的解决方案是使用适当的回调。要访问类成员，可以使用全局变量。不使用全局变量需要一些黑客代码（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;

---

该代码在DLL中的工作方式与在EXE中的工作方式完全相同。不同的可能是在主机中。DLL的主机是什么？当然，您没有执行太多的错误检查，并且每次调用函数时都会泄漏一个句柄。您正在覆盖循环中的输出文件。您显示的代码在应用程序中也无法正常运行。显示一个真实的代码。我不相信你。我建议您提供SSCCE。不要被落选的选票弄得心烦意乱，而是修正你的问题。做一个SSCCE。就这么简单。你抱怨投票否决你的人不知道这个问题。但这就是重点！他们投票否决你是因为你没有有效地沟通你的问题，这使得这个问题很糟糕。人们不投票是因为他们不知道答案。他们投票是因为他们不知道这个问题。编译器有问题吗，呃，用户？提醒我：是的，谢谢你，但是正如你所看到的，在OpenProcess之后，我正在调用另一个过程，这就是重点。我需要这样做。。。如何使用OpenProcess，知道吗？不知道。然而至少我们现在在同一页上。我得说，我觉得你在这里帮不了什么忙。不管怎样，我会努力解决这个问题。这与你无关，但每次我在这里提出一个问题时，我都会从那些根本不想回答的人那里得到负数。这看起来很有趣，另一个人说这个程序不起作用，你可以看到这个程序起作用了。。。我在Win x64上，也许你也是。。。如果DLL是x32，我想我们不能在x64进程上执行OpenProcess。。。这会使线程崩溃。。。或者没有？正如Rob所说，问题是我们无法回答，因为我们不知道这个问题。@user-将其设置为MapProc的本地，并将其与参数一起传递给MapMemory。+1做得好。再次证明使用@operator是致命的。人们不要这样做！！我确实注意到了这个错误，但出于某种原因，我认为这不是问题所在。我想我没有发现句柄不是局部变量。@用户Sertac在这里做得很好，我很高兴你接受了他的答案，而不是我的答案。这就是你问题的答案。但是，我仍然建议您停止使用计时器，使用我在回答中提出的基于同步睡眠的方法。这真的是一个更简单的方法来解决你的问题。正如我在这里多次说过的，不仅仅是对你，还有其他人（包括著名的塞塔克本人！），使用@operator生成

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;