Delphi-DLL远程注入

1. 代码描述

枚举进程,然后向指定进程注入DLL

在被注入的进程窗口按下指定的键码值(#HOME),显示或者隐藏被注入的DLL窗口

未解决的问题：

1. 卸载DLL
2. DLL向exe发送消息
3. 卸载键盘钩子

2. 编码实现

2.1. exe工程

unit UMainForm;

interface

uses
  Generics.Collections, UBaseTools, TlHelp32, Winapi.Windows, Winapi.Messages,
  System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls,
  Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ComCtrls;

type
  TForm1 = class(TForm)
    grp1: TGroupBox;
    mmo1: TMemo;
    btn2: TButton;
    btn3: TButton;
    procedure FormCreate(Sender: TObject);
    procedure btn2Click(Sender: TObject);
    procedure btn3Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
    procedure WndProc(var Message: TMessage); override;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
function AdjustProcessPrivilege(ProcessHandle: THandle; Token_Name: Pchar): boolean;
var
  Token: THandle;
  TokenPri: _TOKEN_PRIVILEGES;
  ProcessDest: int64;
  l: DWORD;
begin
  Result := False;
  if OpenProcessToken(ProcessHandle, TOKEN_ADJUST_PRIVILEGES, Token) then
  begin
    if LookupPrivilegeValue(nil, Token_Name, ProcessDest) then
    begin
      TokenPri.PrivilegeCount := 1;
      TokenPri.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
      TokenPri.Privileges[0].Luid := ProcessDest;
      l := 0;
      //更新进程令牌，成功返回TRUE
      if AdjustTokenPrivileges(Token, False, TokenPri, sizeof(TokenPri), nil, l) then
      begin
        Form1.mmo1.Lines.Add('更新进程令牌成功！');
        Result := True;

      end;

    end;
  end;
end;

function InjectDll(const DllFullPath: string; const dwRemoteProcessId: Cardinal): Boolean;
var
  hRemoteProcess, hRemoteThread: THandle;
  pszLibFileRemote: Pointer;
  pszLibAFilename: PwideChar;
  pfnStartAddr: TFNThreadStartRoutine;
  memSize, lpThreadId: Cardinal;
  WriteSize: SIZE_T;
begin
  Result := false;
  // 调整权限，使程序可以访问其他进程的内存空间
  if AdjustProcessPrivilege(GetCurrentProcess, 'SeDebugPrivilege') then
  begin
    //打开远程线程 PROCESS_ALL_ACCESS 参数表示打开所有的权限
    hRemoteProcess := OpenProcess(PROCESS_ALL_ACCESS, false, dwRemoteProcessId);
    Form1.mmo1.Lines.Add('打开远程线程：' + IntToStr(hRemoteProcess) + ':' + DwordToStr(dwRemoteProcessId));
    try
      // 为注入的dll文件路径分配内存大小,由于为WideChar,故要乘2
      GetMem(pszLibAFilename, Length(DllFullPath) * 2 + 1);
      // 之所以要转换成 WideChar, 是因为当DLL位于有中文字符的路径下时不会出错
      StringToWideChar(DllFullPath, pszLibAFilename, Length(DllFullPath) * 2 + 1);
      // 计算 pszLibAFilename 的长度，注意，是以字节为单元的长度
      memSize := (1 + lstrlenW(pszLibAFilename)) * SizeOf(WCHAR);

      // 使用VirtualAllocEx函数在远程进程的内存地址空间分配DLL文件名空间
      pszLibFileRemote := VirtualAllocEx(hRemoteProcess, nil, memSize, MEM_COMMIT, PAGE_READWRITE);

      if Assigned(pszLibFileRemote) then
      begin
        // 使用WriteProcessMemory函数将DLL的路径名写入到远程进程的内存空间
        if WriteProcessMemory(hRemoteProcess, pszLibFileRemote, pszLibAFilename, memSize, WriteSize) and (WriteSize = memSize) then
        begin
          lpThreadId := 0;
          // 计算LoadLibraryW的入口地址
          pfnStartAddr := GetProcAddress(LoadLibrary('Kernel32.dll'), 'LoadLibraryW');
          // 启动远程线程LoadLbraryW,通过远程线程调用创建新的线程
          hRemoteThread := CreateRemoteThread(hRemoteProcess, nil, 0, pfnStartAddr, pszLibFileRemote, 0, lpThreadId);
          Form1.mmo1.Lines.Add('启动远程线程：' + IntToStr(hRemoteThread));
          // 如果执行成功返回　True;
          if (hRemoteThread <> 0) then
          begin
            Result := true;
          end;
          // 释放句柄
          CloseHandle(hRemoteThread);
        end;
      end;
    finally
      // 释放句柄
      CloseHandle(hRemoteProcess);
    end;
  end;
end;

procedure SetHook(dwThreadId: DWORD; pid: DWORD); stdcall; external 'KeyBoardHook';

procedure StopHook; stdcall; external 'KeyBoardHook';

// 注入

procedure TForm1.btn2Click(Sender: TObject);
var
  {定义一个泛型 TList 类, 这指定了要用于 string}
  List1: TList<Cardinal>;
var
  i: Integer;
var
  IsTrue: Boolean;
begin
  List1 := ListPids('测试程序.exe');

  for i := 0 to List1.Count - 1 do
  begin
    IsTrue := InjectDll('KeyBoardHook.dll', List1[i]);
    SetHook(List1[i], GetCurrentProcessId);
    mmo1.Lines.Add('进程PID2：' + List1[i].ToString + '，注入结果：' + IsTrue.ToString);
  end;
  List1.Free;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  mmo1.Lines.Clear;
  mmo1.Font.Color := clGreen;
end;

//接收消息
procedure TForm1.WndProc(var Message: TMessage);
var
  hSnapShot: THandle;
  pEntry: TProcessEntry32;
  find: Boolean;
  proName: string;
begin
  if Message.Msg = WM_USER + 101 then
  begin
    //创建进程快照
    hSnapShot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
    pEntry.dwSize := SizeOf(pEntry);
    find := Process32First(hSnapShot, pEntry);
    while find do
    begin
      //取进程名字
      proName := pEntry.szExeFile;
      if pEntry.th32ProcessID = Message.LParam then
        Break;
      find := Process32Next(hSnapShot, pEntry);
    end;
    mmo1.Lines.Add('进程：' + proName + ',ID：' + IntToStr(Message.LParam) + '按下按键：' + Chr(Message.WParam));
    CloseHandle(hSnapShot);
  end;
  inherited;

end;

end.

2.2. exe下的工具单元(UBaseTools.pas)

unit UBaseTools;

interface

uses
  Generics.Collections, psapi, Variants, Winapi.Windows, Winapi.Messages, TLHelp32, Vcl.StdCtrls, System.SysUtils, Vcl.Dialogs;

{*------------------------------------------------------------------------------
  枚举游戏进程，获取所有的PID

  @param ProName
  @return
-------------------------------------------------------------------------------}
function ListPids(ProName: string): TList<Cardinal>;

function StrToDword(Value: string): DWORD;

 // DwordToStr() : Converts a DWORD to a 4 byte string
function DwordToStr(Value: dword): string;

implementation

function ListPids(ProName: string): TList<Cardinal>;
var
  ContinueLoop: BOOL;       //是否继续循环
  FSnapshotHandle: THandle; //进程快照句柄
  FProcessEntry32: TProcessEntry32; //进程入口的结构体信息
  pids: string;
  pid: Integer;
  hProcess: THandle;
  ProcessFullPathName: string;
  buf: array[0..MAX_PATH] of Char;
  buf1: array[0..MAX_PATH] of Char;
var
  List: TList<Cardinal>;  {定义一个泛型 TList 类, 这指定了要用于 string}
begin
  List := TList<Cardinal>.Create;
  FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
//CreateToolhelp32Snapshot函数得到进程快照
  FProcessEntry32.dwSize := Sizeof(FProcessEntry32); //初始化
  ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);
//Process32First 得到一个系统快照里第一个进程的信息

  while ContinueLoop do
  begin
   //进程ID
    pid := FProcessEntry32.th32ProcessID;

    hProcess := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, FALSE, pid);
    if hProcess <> 0 then
    begin
      if StrPas(FProcessEntry32.szExeFile) = ProName then
      begin
        List.Add(FProcessEntry32.th32ProcessID);
      end;

    end;

    ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
  end;
  CloseHandle(FSnapshotHandle);
  Result := List;
end;

2.3. DLL工程

library KeyBoardHook;

{ Important note about DLL memory management: ShareMem must be the
  first unit in your library's USES clause AND your project's (select
  Project-View Source) USES clause if your DLL exports any procedures or
  functions that pass strings as parameters or function results. This
  applies to all strings passed to and from your DLL--even those that
  are nested in records and classes. ShareMem is the interface unit to
  the BORLNDMM.DLL shared memory manager, which must be deployed along
  with your DLL. To avoid using BORLNDMM.DLL, pass string information
  using PChar or ShortString parameters. }

uses
  SysUtils,
  Windows,
  Messages,
  Vcl.Dialogs,
  Classes,
  UMainForm in 'UMainForm.pas' {MainForm},
  UPublicTool in 'utils\UPublicTool.pas';

var
  fHook: HHOOK;

type
  IntProc = function(): DWORD;

var
  ParentPid: DWORD = 101;

{$R *.res}
//回调函数
function HookProc(code: Integer; wParam: wParam; lParam: lParam): LRESULT; stdcall;
begin
  //如果有键盘动作
  if code = HC_Action then
  begin
    if (wParam = VK_HOME) and ((1 shl 31) and lParam = 0) then
    begin
      if MainForm = nil then
      begin
        MainForm := TMainForm.CreateParented(GetHWndByPID(lParam));
      end;

      MainForm.Caption := '操蛋的回调函数：' + inttostr(ParentPid);
      MainForm.Visible := not MainForm.Visible;
    end;

  end;

  Result := CallNextHookEx(fHook, code, wParam, lParam);
end;

procedure SetHook(dwThreadId: DWORD); stdcall;
begin
  ParentPid := 123;
  ShowMessage('宿主进程的ID:' + IntToStr(ParentPid));
  //挂钩，这里没有做挂钩失败的提示
  fHook := SetWindowsHookEx(WH_KEYBOARD, @HookProc, HInstance, GetWindowThreadProcessId(GetHWndByPID(dwThreadId)));
end;

procedure StopHook; stdcall;
begin
  //摘钩
  if fHook <> 0 then
    UnhookWindowsHookEx(fHook);
end;

exports
  SetHook name 'SetHook',
  StopHook name 'StopHook',
  HookProc name 'HookProc';

begin

  //ShowMessage('线程ID：' + IntToStr(GetCurrentProcessId));

end.

2.4. DLL下的工具函数单元(DLL\utils\UPublicTool.pas)

unit UPublicTool;

interface

uses
  SysUtils, Windows, Messages, Vcl.Dialogs, Classes;

function GetHWndByPID(const hPID: THandle): THandle;

implementation

function GetHWndByPID(const hPID: THandle): THandle;
type
  PEnumInfo = ^TEnumInfo;

  TEnumInfo = record
    ProcessID: DWORD;
    HWND: THandle;
  end;

  function EnumWindowsProc(Wnd: DWORD; var EI: TEnumInfo): Bool; stdcall;
  var
    PID: DWORD;
  begin
    GetWindowThreadProcessID(Wnd, @PID);
    Result := (PID <> EI.ProcessID) or (not IsWindowVisible(Wnd)) or (not IsWindowEnabled(Wnd));

    if not Result then
      EI.HWND := Wnd; //break on return FALSE 所以要反向檢查
  end;

  function FindMainWindow(PID: DWORD): DWORD;
  var
    EI: TEnumInfo;
  begin
    EI.ProcessID := PID;
    EI.HWND := 0;
    EnumWindows(@EnumWindowsProc, Integer(@EI));
    Result := EI.HWND;
  end;

begin
  if hPID <> 0 then
    Result := FindMainWindow(hPID)
  else
    Result := 0;
end;

end.

---

如果有懂的朋友希望留下联系方式，互相交流一下子