在DLL程序中使用Process32First / Next [英] Using Process32First/Next inside DLL procedure

问题描述

我有以下过程：

 程序MyMainThread.MapProc; 
 var 
句柄：THandle; 
 PID：dword; 
 Struct：TProcessEntry32; 
进程：TStringList; 
 begin 
句柄：= CreateToolHelp32SnapShot（TH32CS_SNAPPROCESS，0）; 
 Struct.dwSize：= Sizeof（TProcessEntry32）; 
 Process32First（Handle，Struct）; 
进程：= TStringList.Create; 
 repeat 
 Processes.Add（Struct.szExeFile）; 
 Processes.SaveToFile（'C：\Log.txt'）; 
 PID：= Struct.th32ProcessID; 
 PIDHandle：= OpenProcess（PROCESS_QUERY_INFORMATION或PROCESS_VM_OPERATION或
 PROCESS_VM_READ，false，PID）; 
 CloseHandle（PIDHandle）; 
 until（not Process32Next（Handle，Struct））; 
 Processes.Free; 
结束
  

如您所见，我将运行的进程保存在C：\Log.txt中，在.exe文件内部工作很好。现在我试图在一个.DLL文件中实现这一点，其概念是：DLL将被加载，它将有一个EntryPoint调用Thread.Create ...该Thread将使用SetTimer来运行过程MapProc每10秒将运行的进程保存在C：\Log.txt中。代码是：

 库Project1; 
 
使用
 Windows，
 SysUtils，
类，
注册表，
 EncdDecd，
 TLHelp32，
 IdHTTP ; 
 
 {$ R * .res} 
 type 
 MyMainThread = Class（TThread）
 var 
 DestDir，ContactHost：String; 
发送：TStringList; 
 PIDHandle：THandle; //需要公开，因为我们在MapProc / CatchYa中使用
 private 
 procedure MapProc; 
程序MapMemory（ProcessName：string）; 
程序CreateMessagePump; 
 protected 
构造函数创建; 
程序执行;覆盖; 
结束
 
构造函数MyMainThread.Create; 
 begin 
继承Create（false）; 
 FreeOnTerminate：= true; 
优先级：= tpNormal; 
结束
 
程序MyMainThread.Execute; 
 begin 
而不是终止do 
 begin 
 SetTimer（0，0，10000，@ MyMainThread.MapProc）; //设置定时器10秒调用MapProc 
 CreateMessagePump; //我们在DLL里面，所以我想我们需要Message Pump来​​定时工作
终止; 
结束
结束
 
 
程序MyMainThread.MapProc; 
 var 
句柄：THandle; 
 PID：dword; 
 Struct：TProcessEntry32; 
进程：TStringList; 
 begin 
句柄：= CreateToolHelp32SnapShot（TH32CS_SNAPPROCESS，0）; 
 Struct.dwSize：= Sizeof（TProcessEntry32）; 
 Process32First（Handle，Struct）; 
过程：= TStringList.Create; 
 repeat 
 Processes.Add（Struct.szExeFile）; 
 Processes.SaveToFile（'C：\Log.txt'）; 
 PID：= Struct.th32ProcessID; 
 PIDHandle：= OpenProcess（PROCESS_QUERY_INFORMATION或PROCESS_VM_OPERATION或
 PROCESS_VM_READ，false，PID）; 
如果POS（Struct.szExeFile，ExeName）= 0然后
 MapMemory（Struct.szExeFile）; //程序调用进行验证，但是甚至没有调用
 CloseHandle（PIDHandle）; 
 until（not Process32Next（Handle，Struct））; 
 Processes.Free; 
结束
 
 
程序MyMainThread.CreateMessagePump; 
 var 
 AppMsg：TMsg; 
 begin 
而GetMessage（AppMsg，0，0，0）do 
 begin 
 TranslateMessage（AppMsg）; 
 DispatchMessage（AppMsg）; 
结束
 //如果需要退出此过程，请使用PostQuitMessage（0）; 
结束
 
 
程序EntryPoint（原因：整数）; 
 begin 
如果Reason = DLL_PROCESS_ATTACH然后
 begin 
 MyMainThread.Create; 
 end 
 else 
如果Reason = DLL_PROCESS_DETACH然后
 begin 
 MessageBox（0，'DLL De-Injected'，'DLL De-Injected'，0）; 
结束
结束
 
 begin 
 DLLProc：= @EntryPoint; 
 EntryPoint（DLL_PROCESS_ATTACH）; 
结束。 
  

但是当运行这个时，我在Log.txt文件中只有行：[System Process]

EXE托管DLL是：

  unit Unit1; 
 
接口
 
使用
 Windows，消息，SysUtils，变体，类，图形，控件，窗体，
对话框，StdCtrls; 
 
 type 
 TForm1 = class（TForm）
 Button1：TButton; 
 procedure Button1Click（Sender：TObject）; 
 private 
 {私人声明} 
 public 
 {公开声明} 
 end; 
 
 var 
 Form1：TForm1; 
 
 
执行
 
 {$ R * .dfm} 
 
 
 
程序TForm1.Button1Click（发件人：TObject）; 
 var 
 HD：THandle; 
 begin 
 HD：= LoadLibrary（'C：\Project1.dll'）; 
结束
 
结束。 
  

解决方案

你的代码失败的原因是你不为 SetTimer 函数使用适当的回调。根据文档应该有一个签名，如

  procedure（hwnd：HWND; uMsg：UINT; idEvent：UINT_PTR; dwTime：DWORD）; STDCALL; 
  

您的不兼容回调 - 这是一个类方法 - 导致代码认为 Self 生活在一个完全任意的内存地址，因为类方法有一个隐式的Self参数，但是winapi没有这方面的知识。现在当代码尝试写入一个无效的地址 - PIDHandle时，假设应该有一个类字段，AV被提出，并且由于该异常不被处理，其余的代码不被执行 - 同样如David的答案。

您的解决方案是使用适当的回调。要访问类成员，可以使用全局变量。不使用全局变量将需要一些黑客代码（Google for MethodToProcedure fi）

样本可能如下所示：

  threadvar 
 MyThread：MyMainThread; 
 
 procedure TimerProc（hwnd：HWND; uMsg：UINT; idEvent：UINT_PTR; dwTime：DWORD）; 
 stdcall; 
 var 
句柄：THandle; 
 PID：dword; 
 Struct：TProcessEntry32; 
进程：TStringList; 
 begin 
句柄：= CreateToolHelp32SnapShot（TH32CS_SNAPPROCESS，0）; 
 Struct.dwSize：= Sizeof（TProcessEntry32）; 
 Process32First（Handle，Struct）; 
进程：= TStringList.Create; 
 repeat 
 Processes.Add（Struct.szExeFile）; 
 Processes.SaveToFile（'C：\Temp\Log3.txt'）; 
 PID：= Struct.th32ProcessID; 
 MyThread.PIDHandle：= OpenProcess（PROCESS_QUERY_INFORMATION或PROCESS_VM_OPERATION或
 PROCESS_VM_READ，false，PID）; 
如果POS（Struct.szExeFile，ExeName）= 0，那么
 MyThread.MapMemory（Struct.szExeFile）; 
 CloseHandle（MyThread.PIDHandle）; 
 until（not Process32Next（Handle，Struct））; 
 Processes.Free; 
结束
 
程序MyMainThread.Execute; 
 begin 
而不是终止do 
 begin 
 MyThread：= Self; 
 SetTimer（0，0，10000，@TimerProc）; 
 CreateMessagePump; 
终止; 
结束
结束为了拿大卫的建议，不要被'@'操作员殴打，我们应该首先重新声明一下这个@  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; 
 
函数SetTimer（hWnd：HWND; nIDEvent：UIntPtr; uElapse：UINT; 
 lpTimerFunc：TFNTimerProc）：UINT; STDCALL;外部用户32; 
 
程序MyMainThread.Execute; 
 begin 
 MyThread：= Self; 
 SetTimer（0，0，10000，TimerProc）; 
 CreateMessagePump; 
结束
  
 
I have the following procedure:
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;
As you can see, I save the running processes inside C:\Log.txt, and this works nice when inside an .exe file. Now I'm trying to implement this inside a .DLL file, and the concept is: The DLL will be loaded, and it will have an EntryPoint calling a Thread.Create... This Thread will use a SetTimer to run the procedure MapProc every 10 seconds to save the running processes in C:\Log.txt. The code is:
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.
But when running this, I get in the Log.txt file only the line: [System Process]

The exe hosting DLL is:
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.

解决方案
The reason that your code fails is that you're not using a proper callback for the SetTimer function. As per the documentation that should have a signature like
procedure (hwnd: HWND; uMsg: UINT; idEvent: UINT_PTR; dwTime: DWORD); stdcall;
Your incompatible callback - which is a class method - causes the code to think the Self lives at a completely arbitrary memory address, as class methods has an implicit Self parameter but winapi has no knowledge of that. Now when the code tries to write to an invalid address - 'PIDHandle', assuming there should be a class field, an AV is raised and since the exception is not handled the rest of the code is not executed - also as explained in David's answer.

Your solution is to use a proper callback. To access class members you can use a global variable. Not using a global variable would require some hacky code (google for MethodToProcedure f.i.)

A sample could be like:
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;
To take David's advice, not to get beaten by the '@' operator, we should first redeclare the SetTimer function to use the callback correctly. That would look something like:
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程序中使用Process32First / Next的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！