Using Process32First/Next inside DLL procedure - delphi

Question

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.

Answer 1

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;

Answer 2

Here's a version that works as you'd expect. This proves that process enumeration using toolhelp32 works perfectly well from a DLL.
Library
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.
Host
program ProcessEnumHost;
{$APPTYPE CONSOLE}
uses
Windows;
begin
LoadLibrary('ProcessEnumLib.dll');
Sleep(1000);
end.
Your version is failing because the call to OpenProcess is raising an access violation which is killing the thread. Right now, I'm not sure why that is so.
I suggest that you simplify grossly. You don't need a message loop, and you don't need a timer. You can use Sleep in your thread to pause between process maps. Something like this:
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.
I've no idea why, but this variant avoids the AV when calling OpenProcess. I'd love to know why. But it's the right way for you to do what you want, and it side-steps the problem.