Форум: "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