0

我有以下程序：

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，并且它将有一个调用 Thread.Create 的入口点...此线程将使用 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 文件中只有一行：[系统进程]

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.
4

2 回答 2

5

您的代码失败的原因是您没有为SetTimer函数使用正确的回调。根据应该有一个签名的文档，比如

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

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

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

一个样本可能是这样的：

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;
于 2013-08-28T01:18:09.160 回答
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. 我很想知道为什么。但这是你做你想做的事的正确方法，它回避了问题。

于 2013-08-27T21:02:21.710 回答