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 を呼び出す EntryPoint が作成されます。この 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.
4

2 に答える 2

5

コードが失敗する理由は、SetTimer関数に適切なコールバックを使用していないためです。次のような署名が必要なドキュメントに従って

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

クラスメソッドである互換性のないコールバックにより、コードSelfは完全に任意のメモリアドレスに住んでいると見なされます。クラスメソッドには暗黙の Self パラメータがありますが、winapi はそれを認識していません。コードが無効なアドレス-「PIDHandle」に書き込もうとすると、クラスフィールドが必要であると仮定すると、AVが発生し、例外が処理されないため、残りのコードは実行されません-また、Davidの回答で説明されているように.

あなたの解決策は、適切なコールバックを使用することです。クラス メンバーにアクセスするには、グローバル変数を使用できます。グローバル変数を使用しないと、ハッキーなコードが必要になります (MethodToProcedure fi の場合は google)。

サンプルは次のようになります。

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.

理由はわかりませんが、このバリアントは を呼び出すときに AV を回避しOpenProcessます。理由を知りたいです。しかし、それはあなたがやりたいことをするための正しい方法であり、問​​題を回避します.

于 2013-08-27T21:02:21.710 に答える