Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2013.03.22;
Скачать: CL | DM;

Вниз

Как заставить 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 вся ветка

Текущий архив: 2013.03.22;
Скачать: CL | DM;

Наверх




Память: 0.63 MB
Время: 0.085 c
2-1341990007
sas9568635
2012-07-11 11:00
2013.03.22
Получение кода нажатых клавиш формы запущенной как Form.Show


2-1334968397
bobby
2012-04-21 04:33
2013.03.22
Помогите с TreeView


15-1339791776
OPOPO
2012-06-16 00:22
2013.03.22
Как отключить Alt+Tab В XP?


15-1351844355
>|<
2012-11-02 12:19
2013.03.22
Active Directory


15-1351704720
Дмитрий С
2012-10-31 21:32
2013.03.22
Ком сервер в сервисе.