Best way to add items to another application's modal window?

Question

What's the best way to add items to another application's modal window?

The simple example I've written for this (as a proof of concept) uses a method that I suspect is much, much too processor intensive for a trivial background process but I am having trouble coming up with an alternative.

For example, let's say you are a physician filling out a modal window with prescription data. You enter it for 30 days with 11 refills and then the patient says they want 90 days with 3 refills. The original application (which you don't have access to the source for) has no easy conversion. I wrote a small utility which watches for this particular window (using a timer and findwindow) and when it finds it, makes itself visible and places itself in an empty spot on the target modal window. When the "30" button is pressed, the Rx is written for 30 days with 11 refills and when the "90" button is pressed, it does what you'd expect. If the modal window moves, the 30 and 90 buttons move with it. While this works, I am concerned about the overhead involved in running findwindow on a timer repeatedly.

1) is there a better way? 2) am I right to be concerned about this? 3) are you chuckling at how inefficient my kluge is?

Thanks in advance - I've been very impressed with the folks here!

Answer 1

The best way is... DLL injection.

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