delphi - 将项目添加到另一个应用程序的模式窗口的最佳方法？

Question

将项目添加到另一个应用程序的模式窗口的最佳方式是什么？

我为此编写的简单示例(作为概念证明)使用了一种方法，我怀疑该方法对于微不足道的后台进程来说过于处理器密集型，但我无法想出替代方案。

例如，假设您是一名医生，正在使用处方数据填写模态窗口。您输入 30 天并补充 11 次，然后患者说他们想要 90 天并补充 3 次。原始应用程序(您无权访问其源代码)无法轻松转换。我编写了一个小实用程序，它监视这个特定的窗口(使用计时器和 findwindow)，当它找到它时，使其自身可见并将其自身放置在目标模式窗口上的空白位置。当按下“30”按钮时，处方会写入 30 天，并可补充 11 次；当按下“90”按钮时，它会达到您所期望的效果。如果模态窗口移动，30 和 90 按钮也会随之移动。虽然这有效，但我担心在计时器上重复运行 findwindow 所涉及的开销。

1)有更好的方法吗？2)我对此的担心是否正确？3)你是不是在 mock 我的杂技效率低下？

提前致谢 - 这里的人们给我留下了深刻的印象!

Answer 1

最好的方法是...DLL注入(inject)。

// The DLL:
library dll_inj;

uses
  ShareMem,
  System.SysUtils,
  System.Classes, Vcl.Dialogs,
  windows, messages;

{$R *.res}

var
  hWndMain, hDemoButton, hEdit, hNewButton, hWndEnter: THandle;
  OldWndProc: TFarProc;
  hBtnFont: hFont;
  Times: integer;
  dwThreadId: DWORD;

function NewWndProc(hWnd: hWnd; Msg: UINT; wParam: wParam; lParam: lParam)
  : Longint; stdcall;
begin
  if Times = 0 then
  begin
    Times := Times + 1;
    hWndMain := FindWindowEx(0, 0, 'TForm1', 'Injection test');
    if hWndMain = 0 then
      OutputDebugString('hWndMain is 0!');

    hNewButton := CreateWindow('button', 'NewBtn', WS_CHILD or WS_VISIBLE, 20,
      20, 100, 24, hWndMain, 2000, GetWindowLong(hWndMain, GWL_HINSTANCE), nil);
    if hNewButton = 0 then
      OutputDebugString('CreateWindow failed!')
    else
    begin
      hWndEnter := FindWindowEx(hWndMain, 0, 'TBitBtn', 'Enter');
      if hWndEnter <> 0 then
        hBtnFont := SendMessage(hWndEnter, WM_GETFONT, 0, 0);
      if hBtnFont <> 0 then
        SendMessage(hNewButton, WM_SETFONT, hBtnFont, 1);
    end;

    hDemoButton := FindWindowEx(hWndMain, 0, 'TButton', 'Demo');
    if hDemoButton <> 0 then
    begin
      if not EnableWindow(hDemoButton, true) then
        OutputDebugString('EnableWindow failed!');
    end
    else
      OutputDebugString('hDemoButton is 0!');

    hEdit := FindWindowEx(hWndMain, 0, 'TEdit', 'Serial');
    if hEdit = 0 then
      OutputDebugString('hEdit is 0!')
    else if not SetWindowText(hEdit, 'You have been hacked') then
      OutputDebugString('SetWindowText failed!');
  end;

  case Msg of
    WM_COMMAND:
      if (hNewButton <> 0) and (DWORD(lParam) = hNewButton) then
        MessageBox(HWND_DESKTOP, 'You pressed a new button!', 'Yay!', MB_OK)
      else if (hWndEnter <> 0) and (DWORD(lParam) = hWndEnter) then
      begin
        MessageBox(HWND_DESKTOP, 'This message is not default anymore!',
          'Override!', MB_OK);
        Exit(0); // Suppress default event completely
      end;
  end;
  Result := CallWindowProc(OldWndProc, hWnd, Msg, wParam, lParam);
end;

procedure EntryPoint(Reason: integer);
begin
  hWndMain := FindWindowEx(0, 0, 'TForm1', 'Injection test');
  if hWndMain = 0 then
  begin
    OutputDebugString('hWndMain is 0!');
    Exit;
  end;

  OldWndProc := TFarProc(SetWindowLong(hWndMain, GWL_WNDPROC,
    LONG(@NewWndProc)));

  MessageBox(0, 'DLL Injected', 'OK', 0);
end;

begin
  CreateThread(nil, 0, @EntryPoint, nil, 0, &dwThreadId);

end.

// The injector:
program exe_inj2;

{$APPTYPE CONSOLE}
{$R *.res}

uses
  System.SysUtils, windows, TLHelp32;

Function EnumThreadProc(wnd: HWND; Var appHwnd: HWND): LongBool; stdcall;
Var
  buf: array [0 .. 256] of Char;
Begin
  Result := LongBool(1);
  if GetClassname(wnd, buf, sizeof(buf)) > 0 then
    If StrComp(buf, 'TApplication') = 0 Then
    Begin
      appHwnd := wnd;
      Result := False;
    End;
End;

Function FindApplicationWindow(forThreadID: DWORD): HWND;
Begin
  Result := 0;
  EnumThreadWindows(forThreadID, @EnumThreadProc, lparam(@Result));
End;

Function ProcessIDFromAppname32(appname: String): DWORD;
{ Take only the application filename, not full path! }
Var
  snapshot: THandle;
  processEntry: TProcessEntry32;
Begin
  Result := 0;
  appname := UpperCase(appname);
  snapshot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  If snapshot <> 0 Then
    try
      processEntry.dwSize := sizeof(processEntry);
      If Process32First(snapshot, processEntry) Then
        Repeat
          If Pos(appname,
            UpperCase(ExtractFilename(StrPas(processEntry.szExeFile)))) > 0 Then
          Begin
            Result := processEntry.th32ProcessID;
            Break;
          End; { If }
        Until not Process32Next(snapshot, processEntry);
    finally
      CloseHandle(snapshot);
    End; { try }
End;

function InjectDLL(dwPID: DWORD; DLLPath: PWideChar): integer;
var
  dwThreadID: Cardinal;
  hProc, hThread, hKernel: THandle;
  BytesToWrite, BytesWritten: SIZE_T;
  pRemoteBuffer, pLoadLibrary: Pointer;
begin
  if not FileExists(DLLPath) then
  begin
    MessageBox(0, PWideChar('File ' + DLLPath + ' does not exist'), 'Error', 0);
    Exit(0);
  end;

  hProc := OpenProcess(PROCESS_CREATE_THREAD or PROCESS_QUERY_INFORMATION or
    PROCESS_VM_OPERATION or PROCESS_VM_WRITE or PROCESS_VM_READ, False, dwPID);
  if hProc = 0 then
    Exit(0);
  try
    BytesToWrite := sizeof(WideChar) * (Length(DLLPath) + 1);
    pRemoteBuffer := VirtualAllocEx(hProc, nil, BytesToWrite, MEM_COMMIT,
      PAGE_READWRITE);
    if pRemoteBuffer = nil then
      Exit(0);
    try
      if not WriteProcessMemory(hProc, pRemoteBuffer, DLLPath, BytesToWrite,
        BytesWritten) then
        Exit(0);
      hKernel := GetModuleHandle('kernel32.dll');
      pLoadLibrary := GetProcAddress(hKernel, 'LoadLibraryW');
      hThread := CreateRemoteThread(hProc, nil, 0, pLoadLibrary, pRemoteBuffer,
        0, dwThreadID);
      try
        WaitForSingleObject(hThread, INFINITE);
      finally
        CloseHandle(hThread);
      end;
    finally
      VirtualFreeEx(hProc, pRemoteBuffer, 0, MEM_RELEASE);
    end;
  finally
    CloseHandle(hProc);
  end;
  Exit(1);
end;

const
  PROCESS_NAME = 'Default_project.exe';

begin
  try
    { TODO -oUser -cConsole Main : Insert code here }
    WriteLn(PROCESS_NAME + ' PID: ' +
      IntToSTr(ProcessIDFromAppname32(PROCESS_NAME)));
    InjectDLL(ProcessIDFromAppname32(PROCESS_NAME), 'dll_inj.dll');
    ReadLn;
  except
    on E: Exception do
      WriteLn(E.ClassName, ': ', E.Message);
  end;

end.