Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "WinAPI";
Текущий архив: 2013.03.22;
Скачать: [xml.tar.bz2];

Вниз

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

 
Leonid Troyanovsky ©   (2009-11-24 15:13) [0]

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

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

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

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

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

--
Regards, LVT.


 
Игорь Шевченко ©   (2009-11-24 15:55) [1]

как делает back orifice ?


 
DVM ©   (2009-11-24 16:16) [2]


> Leonid Troyanovsky ©

Если коротко, нужно создать окно с требуемыми характеристиками в потоке чужого процесса?


 
Leonid Troyanovsky ©   (2009-11-24 16:25) [3]


> Игорь Шевченко ©   (24.11.09 15:55) [1]

> как делает back orifice ?

Ну, вроде того :)

Так и Джеф Рихтер делал, окно в проводнике, ЕМНИП.

--
Regards, LVT.


 
Leonid Troyanovsky ©   (2009-11-24 16:31) [4]


> DVM ©   (24.11.09 16:16) [2]

> Если коротко, нужно создать окно с требуемыми характеристиками
> в потоке чужого процесса?

Ну, да :)
Я даже стили некоторые знаю, message-only.

Решил, вот, выправить кривой топик.
А то, может, и,  впрямь, высокомерен был.

--
Regards, LVT.


 
Leonid Troyanovsky ©   (2009-11-24 16:34) [5]

Всем участникам спасибо!

Проблема решилась:
http://delphimaster.net/view/4-1258675071/

Будет время, направлю в фак какой-нить.

--
Regards, LVT.


 
Anatoly Podgoretsky ©   (2009-11-24 16:43) [6]

> Leonid Troyanovsky  (24.11.2009 16:25:03)  [3]

И молчит?


 
Игорь Шевченко ©   (2009-11-24 17:47) [7]

Leonid Troyanovsky ©   (24.11.09 16:25) [3]


> Так и Джеф Рихтер делал, окно в проводнике, ЕМНИП.


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


 
Игорь Шевченко ©   (2009-11-24 17:50) [8]

Leonid Troyanovsky ©   (24.11.09 16:25) [3]


> > как делает back orifice ?
>
> Ну, вроде того :)


Так исходники в сети есть - он не так просто делает, как кажется поначалу.


 
Leonid Troyanovsky ©   (2009-11-24 18:15) [9]


> Anatoly Podgoretsky ©   (24.11.09 16:43) [6]

> И молчит?

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


> Игорь Шевченко ©   (24.11.09 17:47) [7]

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

Игорь, если книга под рукой, посмотри, плиз,
а то опять буду думать, что напутал.

--
Regards, LVT.


 
Leonid Troyanovsky ©   (2009-11-24 18:18) [10]


> Игорь Шевченко ©   (24.11.09 17:50) [8]

> Так исходники в сети есть - он не так просто делает, как
> кажется поначалу.

С вертолета, танка - это все неспортивно :)

Ну, ладно, как доделаю, кину сюда, если никто не против.

--
Regards, LVT.


 
Игорь Шевченко ©   (2009-11-24 19:27) [11]

Leonid Troyanovsky ©   (24.11.09 18:15) [9]

>
> Игорь, если книга под рукой, посмотри, плиз,
> а то опять буду думать, что напутал.


"Внедрение DLL с помощью ловушек", страница 537
Рихтер, Windows для профессионалов, 4-ое издание


 
Leonid Troyanovsky ©   (2009-11-24 19:53) [12]


> Игорь Шевченко ©   (24.11.09 19:27) [11]

> "Внедрение DLL с помощью ловушек", страница 537

Т.е., окна в проводнике он не создавал?

--
Regards, LVT.


 
Игорь Шевченко ©   (2009-11-24 21:47) [13]

Leonid Troyanovsky ©   (24.11.09 19:53) [12]

Рихтер описывает внедрение DLL в чужой процесс
При этом он (в четвертом издании):
1. сохраняет позиции икон на рабочем столе.
2. создает список всех DLL загруженных чужим процессом.

примеров создания окон в проводнике в этой главе (22) нет :)

В третьем издании он разворачивает окно Program Manager, когда закрыто последнее пользовательское приложение и тоже создает список DLL чужого процесса.


 
Leonid Troyanovsky ©   (2009-11-24 22:13) [14]


> Игорь Шевченко ©   (24.11.09 21:47) [13]

> примеров создания окон в проводнике в этой главе (22) нет

Вот, опять :(
Казалось ведь, что хорошо помнилось.
Sorry.

Т.е., ДР тут ни причем.

А может второе издание? :)

--
Regards, LVT.


 
Игорь Шевченко ©   (2009-11-24 22:15) [15]

Leonid Troyanovsky ©   (24.11.09 22:13) [14]

Во втором издании гарантировано не было проводника :) Третье издание относится к Windows 95 и Windows NT 3.5


 
Leonid Troyanovsky ©   (2009-11-24 22:29) [16]


> Игорь Шевченко ©   (24.11.09 22:15) [15]

> Во втором издании гарантировано не было проводника :)

Всё-всё, сдаюсь.

Значит, back orifice only.

Противно.
Хотя, по-крайней мере, знаем, откуда ноги растут :)

--
Regards, LVT.


 
Игорь Шевченко ©   (2009-11-24 22:35) [17]

Leonid Troyanovsky ©   (24.11.09 22:29) [16]

Рихтер много рассказывает о путях внедрения, через AppInit_DLL, через хуки, через CreateRemoteThread, но примеры только те, что я перечислил :)


 
Leonid Troyanovsky ©   (2009-11-24 22:51) [18]


> Игорь Шевченко ©   (24.11.09 22:35) [17]

>  через хуки, через CreateRemoteThread, но примеры только
> те, что я перечислил :)

Да, давненько я не брал в руки шашки.
Т.е., мелкие тексты - в инете, а крупнее - в ебук.

Как в том анекдоте: мелкую рыбу отпускаем,
а крупную - складываем в майонезную банку.

--
Regards, LVT.


 
Eraser ©   (2009-11-25 00:38) [19]

если интересует готовая реализация на делфи, то вот http://www.wasm.ru/author.php?author=Ms-Rem


 
SPeller ©   (2009-11-25 02:38) [20]

Спасибо за то, что про хуки напомнили, как же я о них забыл-то? :)

Накидал вот такой код:

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;


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


 
SPeller ©   (2009-11-25 05:24) [21]

Немного поправил, сделал перечисление всех окон и в цикле потом слать им сообщения пока окно не создастся. Еще мания у меня какая-то суспендить поток. Тут это сделал для того, чтобы немного снизить шансы изменения списка окон во время перечисления. Может, я опять всё усложняю? :) Наверное, хотябы одно, главное окно в потоке будет и на нем SendMessage отработает.


 
SPeller ©   (2009-11-25 05:39) [22]

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

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;


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

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


 
SPeller ©   (2009-11-25 11:17) [24]

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


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


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

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

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

--
Regards, LVT.


 
Leonid Troyanovsky ©   (2009-11-25 13:43) [26]


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

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

--
Regards, LVT.


 
Leonid Troyanovsky ©   (2009-11-25 13:51) [27]


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

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

--
Regards, LVT.


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

SPeller ©   (25.11.09 11:17) [24]


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


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


 
SPeller ©   (2009-11-25 16:21) [29]


> 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 16:33) [30]


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


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

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

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


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


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

> Ага, учту.

Надеюсь.

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

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

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

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

--
Regards, LVT.


 
SPeller ©   (2009-11-26 01:49) [32]


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


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


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


 
SPeller ©   (2009-11-26 05:01) [33]

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


 
SPeller ©   (2009-11-26 05:31) [34]

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

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;


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

SPeller ©   (26.11.09 01:49) [32]


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


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

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


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


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


 
SPeller ©   (2009-11-26 16:28) [36]


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


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


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


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


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


 
Leonid Troyanovsky ©   (2009-11-26 19:32) [38]

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

Вот обещанное:
--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.


 
Leonid Troyanovsky ©   (2009-11-26 19:33) [39]

Окончание.

--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:46) [40]


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

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

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

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

--
Regards, LVT.



Страницы: 1 2 вся ветка

Форум: "WinAPI";
Текущий архив: 2013.03.22;
Скачать: [xml.tar.bz2];

Наверх




Память: 0.62 MB
Время: 0.061 c
15-1351951907
brother
2012-11-03 18:11
2013.03.22
Антивирус на win2008 x64


15-1342072358
AV
2012-07-12 09:52
2013.03.22
Эффективность подразделения в компании


15-1344457802
Юрий
2012-08-09 00:30
2013.03.22
С днем рождения ! 9 августа 2012 четверг


15-1353484275
RWolf
2012-11-21 11:51
2013.03.22
TVirtualStringTree, баг отрисовки


15-1352901277
ЕщеОдинКакжеНадоели
2012-11-14 17:54
2013.03.22
Удалить кусок текста.





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский