| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

Как заставить GUI thread создать нужное мне окно?

Страницы:   < 1 2 3 >

Leonid Troyanovsky ©   (2009-11-24 15:13:00) 

Хочется, чтобы GUI thread (моего процесса или
чужого) создал нужное мне окно (ThreadID есть).

Это окно буду пользовать для исполнения нужного мне
кода в контексте этого потока путем обработки сообщений,
посланных через SendMessage (отправлять умею).

Доступа к исходникам этого приложения у меня нет,
но мой код не вредоносный (мамой клянусь), бо,
это скины всяки-разны, собс-ручный маршаллинг
и проч. фигня (подробности могу почтой).

Прошу уважаемую общественность пнуть мну
в нужном направлении, бо облазив весь гугль
натыкался лишь на сомнительные варианты с debug API.

Печенкой чую, что искомое где-то рядом,
но, наверное, позабыл как его звать.

--
Regards, LVT.

---

SPeller   (2009-11-27 02:48:00) [1]

> подробности где-то есть ?
Нет, наврал я, извиняюсь. Почему сделал такой вывод пол года назад - не помню. Посмотрел еще раз исходники реактос - там через общую очередь идет обмен сообщениями с окнами апартментов.

---

Leonid Troyanovsky   (2009-11-26 19:46:00) [2]

> Leonid Troyanovsky ©   (26.11.09 19:33) [39]

Да, еще хотел сказать, что хранение хендлов небезопасно,
бо хук снимается сразу и никаких уведомлений не будет.

Ну, и при закрытии собс-ного, приложения созданные
окна надо, конечно, прибивать.

Все эти тонкости, как и контроль за ошибками, оставлю
в качестве домашнего задания заинтересованным лицам.

--
Regards, LVT.

---

Leonid Troyanovsky   (2009-11-26 19:33:00) [3]

Окончание.

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

--EOF mywnd.pas--

--myhook.pas--

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.

--EOF myhook.pas--

Всего 5 файлов.

--
Regards, LVT.

---

Leonid Troyanovsky   (2009-11-26 19:32:00) [4]

Приветствую всех!

Вот обещанное:
--mydll.dpr--

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.

--EOF mydll.dpr--

--myconsts.pas--

unit myconsts;

interface

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

implementation

end.

--EOF myconsts.pas--

--mydllres.rc--

#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
}

--EOF mydllres.rc--

Продолжение следует.

--
Regards, LVT.

---

Игорь Шевченко   (2009-11-26 16:35:00) [5]

> Система при появлении в очереди сообщения маршалинга смотрит
> есть ли апартмент, если есть - отдает ему сообщение и не
> тревожит пользовательский цикл выборки


подробности где-то есть ?

---

SPeller   (2009-11-26 16:28:00) [6]

> очередь сообщений потока - это то, откуда ты выбираешь сообщения
Система при появлении в очереди сообщения маршалинга смотрит есть ли апартмент, если есть - отдает ему сообщение и не тревожит пользовательский цикл выборки, т.е. WaitMessage и GetMessage продолжают ожидать сообщения, поэтому хуки ставить туда бесполезно. Жить же без своего окна с одним хуком и фильтровать весь поток для всех окон считаю лишним и потенциально опасным. Слать сообщения конкретному окну апартмента, имхо, идеальный вариант.


> ком через границы процессов не ходит
Это уже дком и рпц, отдельная песня, их задача пенедать некий буфер данных на другой конец. Стандартные при этом обязательно попортят нервы с безопасностью.

---

Игорь Шевченко   (2009-11-26 14:06:00) [7]

SPeller ©   (26.11.09 01:49) [32]


> А внедряться ком-у никуда не надо только потому, что он
> имеет свой коллбэк в системной очереди сообщений потока


Что за Callback "в системной очереди сообщений потока" ?

Какое отношение к очереди сообщений имеют вообще какие-то callback-и ?
очередь сообщений потока - это то, откуда ты выбираешь сообщения по GetMessage,PeekMessage, также на выборку сообщений можно ставить хук.


> Заглушки используются не только когда клиент и сервер разнесены,
>  но и когда клиент и сервер в разных апартментах


Не вижу ничего принципиального - ком через границы процессов не ходит, а на одном компьютере эти процессы или на разных - несущественно, разве что протокол обмена может изменяться (а может и не изменяться)

---

SPeller   (2009-11-26 05:31:00) [8]

От перечисления окон вообще отказался, можно ведь иметь очередь и не иметь окон.

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;



> Leonid Troyanovsky ©   (25.11.09 23:07) [31]
> > SPeller ©   (25.11.09 16:21) [29]
> > > Что есть WndProc?
> > Указатель на оконную процедуру.
> Надо бы посмотреть.
Пока простая тестовая заглушка:

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;


---

SPeller   (2009-11-26 05:01:00) [9]

Где у винды в системной очереди выход на ком - достоверно не известно, но в ReactOS есть отдельное оконное сообщение, отсылаемое окну апартмента, при получении которого система без обращения к пользовательскому коду вызывает процедуру маршалинга. Думаю, что в виндах аналогично. В моем случае будет то же самое, только цепочка между приходом сообщения и началом маршалинга будет немного длиннее из-за цикла выборки сообщений в приложении, но разница будет не существенна.

---

SPeller   (2009-11-26 01:49:00) [10]

> Игорь Шевченко ©   (25.11.09 16:33) [30]
rsdn читал, всё не то :) Заглушки используются не только когда клиент и сервер разнесены, но и когда клиент и сервер в разных апартментах. Через заглушки сейчас всё и реализовано. С прокси/стабами рабозрался :) Перехваты апи для маршалинга интерфейсов, передаваемых в параметрах вызовов, решаю через правку таблиц импорта. А внедряться ком-у никуда не надо только потому, что он имеет свой коллбэк в системной очереди сообщений потока, а мне чтобы это повторить нужно извернуться.


> Надо бы посмотреть
120 кб выложить? :)


> Лучше, чтобы ненужное рушил хозяин
Это понятно, просто вдруг ошибка, чтобы окно не висело.

---

Leonid Troyanovsky   (2009-11-25 23:07:00) [11]

> SPeller ©   (25.11.09 16:21) [29]

> Ага, учту.

Надеюсь.

> > Что есть WndProc?
> Указатель на оконную процедуру. В ней, и будет маршалинг.

Надо бы посмотреть.

> Действительно, верно... Не знал. Слать руками WM_DESTROY?

Слать особого смысла не вижу.
Лучше, чтобы ненужное рушил хозяин.

--
Regards, LVT.

---

Игорь Шевченко   (2009-11-25 16:33:00) [12]

> Хочу очень простого - работать с удаленными интерфейсами
> как это позволяет ком, взяв его плюсы и обойдя его минусы


ком позволяет работать очень просто - запускает при обращении к объекту заглушку на клиенте, которая обращается к заглушке сервера на удаленном компьютере. При этом никаких внедрений в чужие неизвестно кем написаные потоки он не производит, ну и маршаллинг, собственно, производится исключительно между заглушками. Мне кажется, в твоем случае все решается правкой таблиц импорта (вместо ole32 на spl32) и реализацией заглушек.

Кроме того, на rsdn был ряд статей про перехват вызовов COM

Я бы так делал.

---

SPeller   (2009-11-25 16:21:00) [13]

> Leonid Troyanovsky ©   (25.11.09 13:40) [25]


> Leonid Troyanovsky ©   (25.11.09 13:43) [26]

Ага, учту.


> Leonid Troyanovsky ©   (25.11.09 13:51) [27]
> Что есть WndProc?

Указатель на оконную процедуру. В ней, и будет маршалинг.


> Кста, вызов DestroyWindow д.б. из потока, создавшего окно.

Действительно, верно... Не знал. Слать руками WM_DESTROY?


> Игорь Шевченко ©   (25.11.09 15:49) [28]
> Прочитал. На мой взгляд ты хочешь странного, соответственно,
>  граблей на этом пути у тебя будет в изобилии

Хочу очень простого - работать с удаленными интерфейсами как это позволяет ком, взяв его плюсы и обойдя его минусы. Основные грабли были с организацией сетевого взаимодействия, особенно со вложенными вызовами (когда клиент вызывает синхронный метод сервера, а сервер при этом вызывает синхронный метод клиента и т.д.). Но это уже побеждено и нуждается лишь в шлифовке. Даже маршалинг интерфейсов, ради которого пришлось перехватывать системные вызовы Api, оказался не столь сложной задачей (спасибо исходникам ReactOS), поскольку времени на отладку многопоточного клиент-сервера ушло гораздо больше. Реализовать различные потоковые модели и инстансинг и будет почти полный аналог стандартного кома. Сейчас все удаленные вызовы у меня идут через tcp, нужно реализовать еще транспорт на пайпах чтобы внутри одной машины работать, а внутри одного процесса так вообще делать обычные вызовы в апартмент или прямо в объект. Главное - что это интересно и практически полезно, и уже применяется.

Да и вообще, грабли это не повод не решать задачу. Зато опыт будет :)

---

Игорь Шевченко   (2009-11-25 15:49:00) [14]

SPeller ©   (25.11.09 11:17) [24]


> Я в первом топике описал, зачем оно надо. Для организации
> апартмента и маршалинга ком-вызовов


Прочитал. На мой взгляд ты хочешь странного, соответственно, граблей на этом пути у тебя будет в изобилии

---

Leonid Troyanovsky   (2009-11-25 13:51:00) [15]

> SPeller ©   (25.11.09 05:39) [22]

Что есть WndProc?
Кста, вызов DestroyWindow д.б. из потока, создавшего окно.

--
Regards, LVT.

---

Leonid Troyanovsky   (2009-11-25 13:43:00) [16]

> SPeller ©   (25.11.09 02:38) [20]

И еще, SetWindowLong должна вызываться, по-крайней мере,
из того же процесса, где создано окно, иначе обломится.
Т.е., из хуковой процедуры.

--
Regards, LVT.

---

Leonid Troyanovsky   (2009-11-25 13:40:00) [17]

> SPeller ©   (25.11.09 02:38) [20]

> Тут, конечно, если нет еще окон в потоке, то ничего и не
> выйдет,

Останавливать целевой поток смысла нет, EnumWindows
перечислит все окна, созданные во время ее вызова.
Во-первых, искать окна имеет смысл после WaitForInputIdle.
Во-вторых, хук нужен на WH_GETMESSAGE, посылаем PostThreadMessage. Если очереди сообщений нет, то он обломится.
А если все нормально, можно создавать свое окно.

--
Regards, LVT.

---

SPeller   (2009-11-25 11:17:00) [18]

Я в первом топике описал, зачем оно надо. Для организации апартмента и маршалинга ком-вызовов. Без окна в гуи-потоке у меня нет других идей как это осуществить для случаев, когда ком-сервер должен взаимодействовать с этим гуем.

---

Игорь Шевченко   (2009-11-25 10:15:00) [19]

Саша, извини за глупый вопрос - а зачем оно надо ? Может, есть какие-то более прямые пути к цели ?

---

SPeller   (2009-11-25 05:39:00) [20]

На данный момент вот такое получилось

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;


---

Страницы:   < 1 2 3 >

Наверх