function CreateWndInThread(idTarget: Cardinal; WndProc: Pointer): HWND;

implementation

var
 HookCS: TRTLCriticalSection;
 HHK: HHOOK;
 TargetTHreadID: Cardinal;
 NewWnd: HWND;
 NewWndCreating: Boolean;

function EnumThreadWndProc(hwnd: HWND; lParam: PInteger): BOOL; stdcall;
begin
 lParam^ := hwnd;
 Result := False;
end;

function HookWndProc(nCode, wParam, lParam: Integer): Integer; stdcall;
begin
 if (nCode >= HC_ACTION) then
 begin
   if (NewWnd = 0) and not NewWndCreating and (GetCurrentThreadId = TargetTHreadID) then
   begin
     NewWndCreating := True;
     NewWnd :=
       CreateWindow(
         'STATIC', 'Test window', WS_VISIBLE, 0, 0, 200, 200, 0, 0, HInstance, nil);
     NewWndCreating := False;
   end;
   Result := CallNextHookEx(HHK, nCode, wParam, lParam);
 end
 else
   Result := CallNextHookEx(HHK, nCode, wParam, lParam);
end;

function CreateWndInThread(idTarget: Cardinal; WndProc: Pointer): HWND;
var
 enumResult: HWND;
 hTarget: THandle;
begin
 Result := 0;
 hTarget := OpenThread(THREAD_ALL_ACCESS, False, idTarget);
 HookCS.Enter;
 TargetTHreadID := idTarget;
 try
   try
     try
       SuspendThread(hTarget);
       try
         enumResult := 0;
         EnumThreadWindows(idTarget, @EnumThreadWndProc, Integer(@enumResult));
         if (enumResult = 0) then
           raise Exception.Create('No windows in the thread');
         HHK := SetWindowsHookEx(WH_CALLWNDPROC, @HookWndProc, HInstance, idTarget);
       finally
         ResumeThread(hTarget);
       end;
       SendMessage(enumResult, WM_USER + 1, 0, 0);
       if (NewWnd = 0) then
         raise Exception.Create('Failed to create window');
       Result := NewWnd;
       NewWnd := 0;
       SetWindowLong(Result, GWL_WNDPROC, Integer(WndProc));
     finally
       TargetTHreadID := 0;
       UnhookWindowsHookEx(HHK);
       HHK := 0;
     end;
   except
     DestroyWindow(NewWnd);
     NewWnd := 0;
     raise;
   end;
 finally
   HookCS.Leave;
   CloseHandle(hTarget);
 end;
end;

initialization
 HookCS.Initialize;

finalization
 HookCS.Destroy;

function CreateWndInThread(idTarget: Cardinal; WndProc: Pointer): HWND;

implementation

var
 HookCS: TRTLCriticalSection;
 HHK: HHOOK;
 TargetThreadID: Cardinal;
 NewWnd: HWND;
 NewWndCreating: Boolean;

type
 TMyArray = array of HWND;
 PMyArray = ^TMyArray;

function EnumThreadWndProc(hwnd: HWND; lParam: PMyArray): BOOL; stdcall;
var
 l: Integer;
begin
 l := Length(lParam^);
 SetLength(lParam^, l + 1);
 lParam^[l] := hwnd;
 Result := True;
end;

function HookWndProc(nCode, wParam, lParam: Integer): Integer; stdcall;
begin
//  if (TargetThreadID <> 0) and (GetCurrentThreadId <> TargetThreadID) then
//    asm int 3; end;
 if
   (nCode >= HC_ACTION) and (NewWnd = 0) and not NewWndCreating and
   (TargetThreadID <> 0)
 then
 begin
   NewWndCreating := True;
   NewWnd :=
     CreateWindow(
       'STATIC', 'Test window', WS_VISIBLE, 0, 0, 200, 200, 0, 0, HInstance, nil);
   NewWndCreating := False;
 end;
 Result := CallNextHookEx(HHK, nCode, wParam, lParam);
end;

function CreateWndInThread(idTarget: Cardinal; WndProc: Pointer): HWND;
var
 threadWindows: TMyArray;
 i, l: Integer;
begin
 Result := 0;
 HookCS.Enter;
 TargetThreadID := idTarget;
 try
   try
     try
       EnumThreadWindows(idTarget, @EnumThreadWndProc, Integer(@threadWindows));
       l := Length(threadWindows);
       if (l = 0) then
         raise Exception.Create('No windows in the thread');
       HHK := SetWindowsHookEx(WH_CALLWNDPROC, @HookWndProc, 0, idTarget);
       i := 0;
       repeat
         SendMessage(threadWindows[i], WM_USER + 1, 0, 0);
         Inc(i);
       until (NewWnd <> 0) or (i >= l);
       if (NewWnd = 0) then
         raise Exception.Create('Failed to create window');
       Result := NewWnd;
       SetWindowLong(Result, GWL_WNDPROC, Integer(WndProc));
     finally
       TargetThreadID := 0;
       UnhookWindowsHookEx(HHK);
       HHK := 0;
     end;
   except
     DestroyWindow(NewWnd);
     raise;
   end;
 finally
   NewWnd := 0;
   HookCS.Leave;
 end;
end;

function CreateWndInThread(idTarget: Cardinal; WndProc: Pointer): HWND;

implementation

var
 HookCS: TRTLCriticalSection;
 HHK: HHOOK;
 TargetThreadID: Cardinal;
 NewWnd: HWND;
 NewWndCreating: Boolean;
 Event: THandle;

function HookMsgProc(nCode, wParam, lParam: Integer): Integer; stdcall;
begin
 if
   (nCode >= HC_ACTION) and (NewWnd = 0) and not NewWndCreating and
   (TargetThreadID <> 0) and (Event <> 0) and (GetCurrentThreadId = TargetThreadID)
 then
 begin
   NewWndCreating := True;
   NewWnd :=
     CreateWindow(
       'STATIC', 'Test window', WS_VISIBLE, 0, 0, 200, 200, 0, 0, HInstance, nil);
   NewWndCreating := False;
   SetEvent(Event);
 end;
 Result := CallNextHookEx(HHK, nCode, wParam, lParam);
end;

function CreateWndInThread(idTarget: Cardinal; WndProc: Pointer): HWND;
var
 r: Integer;
begin
 if (WaitForInputIdle(GetCurrentProcess, INFINITE) = WAIT_FAILED) then
   raise Exception.Create('F*ck');
 Result := 0;
 HookCS.Enter;
 TargetThreadID := idTarget;
 try
   try
     try
       Event := CreateEvent(nil, False, False, nil);
       HHK := SetWindowsHookEx(WH_GETMESSAGE, @HookMsgProc, 0, idTarget);
       r := Integer(PostThreadMessage(idTarget, WM_USER + 1, 0, 0));
       if (r = 0) or (r = ERROR_INVALID_THREAD_ID) then
         raise Exception.Create('Target thread has no message queue or invalid thread ID specified');
       WaitForSingleObject(Event, 30000);
       if (NewWnd = 0) then
         raise Exception.Create('Failed to create window');
       Result := NewWnd;
       SetWindowLong(Result, GWL_WNDPROC, Integer(WndProc));
     finally
       CloseHandle(Event);
       Event := 0;
       TargetThreadID := 0;
       UnhookWindowsHookEx(HHK);
       HHK := 0;
     end;
   except
     SendMessage(NewWnd, WM_DESTROY, 0, 0);
     raise;
   end;
 finally
   NewWnd := 0;
   HookCS.Leave;
 end;
end;

function MyWndProc(hwnd: HWND; uMsg, wParam, lParam: Integer): Integer; stdcall;
begin
 if (tmp = 0) and (GetCurrentThreadId = MainThreadID) then
 begin
   tmp := 1;
   MessageBox(Form1.Handle, 'Work!!!', nil, 0);
 end;
 Result := DefWindowProc(hwnd, uMsg, wParam, lParam);
end;

library mydll;

// Запускаем путем rundll32.exe "mydll.dll",Main
// возможно, что с полными путями. Проще из IDE - Run parameters.
// В эдит - имя окна целевого процесса (должен быть запущен)
// Для разрушения окна нужно в листбоксе выделить хендл.

{$R 'mydll.res' 'mydll.rc'}

uses
 Windows,
 Messages,
 myconsts in 'myconsts.pas',
 myhook in 'myhook.pas',
 mywnd in 'mywnd.pas';

function DlgProc(Dialog: HWnd; msg:UINT; aWParam: WParam; aLParam: LParam):
 Bool; stdcall;
var
 wnd, lbwnd: HWND;
 buf: array [0..255] of Char;
 idx, code: Longint;
 s: String;
 tid: DWORD;
begin
   Result := False;
   case msg of
     WM_SYSCOMMAND:
       if (aWParam and $FFF0 = SC_CLOSE) then
         DestroyWindow(Dialog);
     WM_COMMAND:
       case LoWord(aWParam) of
         IDBtnDone1:
           begin
             Result := True;
             if GetDlgItemText(Dialog, IdEdit, buf,SizeOf(buf)) = 0 then
               begin
                 MessageBox(Dialog, 'Empty name', nil, 0);
                 Exit;
               end;
             wnd := FindWindow(nil, buf);
             if wnd = 0 then
               begin
                 MessageBox(Dialog, 'Invalid window name', nil, 0);
                 Exit;
               end;
             tid := GetWindowThreadProcessId(wnd, nil);
             CreateWndInThread(tid, Dialog);
            end;
         IDBtnDone2:
           begin
             Result := True;
             lbwnd := GetDlgItem(Dialog, IdList);
             idx := SendMessage(lbwnd, LB_GETCURSEL, 0, 0);
             SendMessage(lbwnd, LB_GETTEXT, idx, LParam(@buf));
             Val(buf, wnd, code);
             if code <> 0 then
               begin
                 MessageBox(Dialog, 'Invalid value', nil, 0);
                 Exit;
               end;
             DestroyWnd(wnd);
             SendMessage(lbwnd, LB_DELETESTRING, idx, 0);
           end;
       end;
     WM_DESTROY:
       PostQuitMessage(0);
     WM_USER+1:
       begin
         Result := True;
         lbwnd := GetDlgItem(Dialog, IdList);
         Str(aLParam, s);
         SendMessage(lbwnd, LB_ADDSTRING, 0, LPARAM(s));
       end;
   end;
end;

procedure Main( wnd: HWND;
               hinst: THandle;
               CmdLine: PChar;
               nCmdShow: Longint); stdcall;
var
 dlg: HWND;
 msg: TMsg;
begin
 dlg := CreateDialog ( Hinstance,
                       'Dialog_1',
                       0,
                       @DlgProc);
 if dlg <> 0 then
   begin
     while GetMessage(msg, 0, 0, 0) do
       if not IsDialogMessage(dlg, msg) then
         begin
           TranslateMessage(msg);
           DispatchMessage(msg);
         end;
   end;
end;

exports
 Main;

begin
end.

unit myconsts;

interface

const
 IdBtnDone1    = 20001;
 IdBtnDone2    = 20002;
 IdEdit        = 20003;
 IdList        = 20004;

implementation

end.

#include "myconsts.pas"
DIALOG_1 DIALOG 6, 15, 184, 163
STYLE WS_POPUP|WS_VISIBLE|WS_CAPTION|WS_SYSMENU|WS_EX_STATICEDGE
CAPTION "Create window"
FONT 8, "Tahoma"
{
 PUSHBUTTON "Create", IDBtnDone1, 11, 139, 50, 14
 PUSHBUTTON "Destroy", IDBtnDone2, 124, 139, 50, 14
 CONTROL "Калькулятор", IDEdit, EDIT, WS_CHILD|WS_BORDER|WS_TABSTOP|ES_NOHIDESEL,10, 10,165,12
 CONTROL "", IDList, LISTBOX, WS_CHILD|WS_BORDER|WS_TABSTOP, 10, 24, 165, 100
}

--mywnd.pas--
unit mywnd;

interface

uses
 Windows,
 Messages;

const
 AppName = 'PascalWindowClass';

function ShowWnd: HWND;

implementation

function WindowProc( Wnd: HWND; AMessage: UINT; aWParam: WPARAM;
                    aLParam: LPARAM): LRESULT; stdcall;
var
 buffer : array [0..MAX_PATH] of Char;
begin
 case AMessage of
   WM_DESTROY:
     begin
       Result := 0;
       Exit;
     end;
   WM_USER+1:
     begin
       GetModuleFileName(0, buffer, SizeOf(buffer));
       SetWindowText(wnd, buffer);
     end;
 end;
 Result := DefWindowProc(Wnd, AMessage, aWParam, aLParam);
end;

function WinRegister: Boolean;
var
 WindowClass: TWndClass;
begin
 WindowClass.Style := CS_HREDRAW or CS_VREDRAW;
 WindowClass.lpfnWndProc := @WindowProc;
 WindowClass.cbClsExtra := 0;
 WindowClass.cbWndExtra := 0;
 WindowClass.hInstance := HInstance;
 WindowClass.hIcon := LoadIcon(0, IDI_APPLICATION);
 WindowClass.hCursor := LoadCursor(0, IDC_ARROW);
 WindowClass.hbrBackground := HBrush(Color_Window);
 WindowClass.lpszMenuName := nil;
 WindowClass.lpszClassName := AppName;
 Result := RegisterClass(WindowClass) <> 0;
end;

function ShowWnd: HWND;
begin
 Result := CreateWindow( AppName,
                         'PlainWindow',
                         WS_OVERLAPPEDWINDOW,
                         100, 100, 300, 200,
                         0,
                         0,
                         HInstance,
                         nil);
 if Result = 0 then
   begin
     MessageBox(0, 'CreateWindow failed', nil, mb_Ok);
     Exit;
   end;
 ShowWindow(Result, SW_SHOW);
end;

initialization
 if not WinRegister then
   MessageBox(0, 'Register failed', nil, mb_Ok);
finalization
 UnregisterClass(appname, Hinstance);
end.

unit myhook;

interface

uses
 Windows,
 Messages,
 mywnd;

procedure CreateWndInThread(tid: DWORD; Caller: HWND);
procedure DestroyWnd(wnd: HWND);

implementation

function Done( nCode: Integer; wprm: WParam; lprm: LParam):LResult;
        stdcall;
type
 PMsg = ^TMsg;
var
 buffer : array [0..MAX_PATH] of Char;
 msg : PMsg;
 Caller : HWND;
 AHook: HHook;
 wnd: HWND;
 lib: THandle;
begin
 Result := 0;
 msg := PMsg(lprm);
 if (msg.Message = 0) and (msg.LParam <> 0) then
   begin
     AHook := msg.lParam;
     Caller := msg.wParam;
     if (Caller <> 0) then
       begin
         GetModuleFileName(Hinstance, buffer, SizeOf(buffer));
         LoadLibrary(buffer);
         wnd := ShowWnd;
         SendMessage(wnd, WM_USER+1, 0, 0);
         SendMessage(Caller, WM_USER+1, 0, wnd);
       end
     else
       begin
         wnd := msg.hwnd;
         if wnd <> 0 then
           begin
             DestroyWindow(wnd);
             GetModuleFileName(Hinstance, buffer, SizeOf(buffer));
             lib := GetModuleHandle(buffer);
             if lib <> 0 then
               FreeLibrary(lib);
           end;
       end;
     UnHookWindowsHookEx(AHook);
     PostThreadMessage(GetCurrentThreadID, 0, 0, 0);
   end;
end;

procedure DestroyWnd(wnd: HWND);
var
 AHook: HHOOK;
 tid: DWORD;
begin
 tid := GetWindowThreadProcessId(wnd);
 AHook := SetWindowsHookEx(WH_GETMESSAGE, Done, Hinstance, tid);
 if AHook <> 0 then
   PostMessage(wnd, 0, 0, AHook);
end;

procedure CreateWndInThread(tid: DWord; Caller: HWND);
var
 AHook: HHOOK;
begin
 AHook := SetWindowsHookEx(WH_GETMESSAGE, Done, Hinstance, tid);
 if AHook <> 0 then
   PostThreadMessage(tid, 0, Caller, AHook);
end;

end.