Версия для печати темы

Нажмите сюда для просмотра этой темы в обычном формате

Форум «Всё о Паскале» _ Делфи _ Хук на HCBT_CREATEWND

Автор: Unconnected 14.09.2010 3:07

Привет всем smile.gif

Надо поставить хук на создание окон. Нашел (и слегка модифицировал) такой код:


var HookHandle: hHook;

function CBTProc(Code: integer; WParam: word; LParam: Integer): Longint; stdcall;
type PCBT_CREATEWND=^CBT_CREATEWND;
var s: pchar;
z: PCBT_CREATEWND;
ok: Integer;
s2:string;
i:byte;
begin
if Code<0 then begin
Result := CallNextHookEx(HookHandle, code, WParam, LParam);
exit;
end;
case Code of
HCBT_CREATEWND: begin
z:=PCBT_CREATEWND(LParam);
s:=z.lpcs.lpszName;
if s<>nil then begin
s2:='';
for i:=1 to length(s) do begin
s2:=s2+s^;
inc(s);
end;
if pos('Блокнот',s2)>0 then begin
Result:=1;
exit;
end;
end;
end;
end;
Result := 0;
end;

begin
HookHandle := SetWindowsHookEx(WH_CBT, @CBTProc, HInstance, 0);
end;


Я сделал перевод из pchar в string, до этого там была какая-то жутко тупая проверка, которая почему-то работала. Этот код, как я понял, распространяется только на моё приложение. hookhandle>=0.

Автор: volvo 14.09.2010 3:59

Хм. Интересно, куда подевались все вопросительные знаки? smile.gif Ты хоть один видишь? Я почему-то нет. Вопрос-то в чем?

Автор: Unconnected 14.09.2010 4:05

В том, что код не работает как надо ) (по идее, при открытии блокнота блокнот не должен открыться).

Автор: volvo 14.09.2010 4:59

Цитата
по идее, при открытии блокнота блокнот не должен открыться
С чего бы это? Заголовок окна Блокнота создается при обработке WM_CREATE, а хук твой срабатывает до того, как Блокноту будет выслано сообщение WM_CREATE. Пользуйся WH_SHELL-ом, а не WH_CBT.

Автор: Unconnected 14.09.2010 5:22

Нуу.. я изменил code на WH_Shell, этого достаточно? Пока всё равно не ловит.

Автор: volvo 14.09.2010 5:35

Цитата
этого достаточно?
Нет, конечно. Но меня посетила шальная мысль: а чего бы тебе в твоем предыдущем коде не проверять результат GetClassName? Класс окна блокнота известен: "Notepad" (и менять его, вроде, MS не собирается). Попробуй. Вот эта информация должна быть известна уже ДО отсылки приложению WM_CREATE, класс-то уже создан...

Автор: Unconnected 14.09.2010 19:09

Дык это только в примере блокнот, может я ещё чего-нибудь запретить захочу, универсальность нужна.. smile.gif

Пошукал в msdn, кажется надо так примерно:


function CBTProc(Code: integer; WParam: word; LParam: Integer): Longint; stdcall;
type PCBT_CREATEWND=^CBT_CREATEWND;
var s: pchar;
s2:string;
i:byte;
z: PCBT_CREATEWND;
begin
if Code<0 then begin
Result := CallNextHookEx(HookHandle, code, WParam, LParam);
exit;
end;
case code of
HSHELL_WINDOWCREATED: begin
z:=PCBT_CREATEWND(HSHELL_LANGUAGE); //hshell_language по мсдн должен возвращать хэндл окна
s:=z.lpcs.lpszName;
if s<>nil then begin
s2:='';
for i:=1 to length(s) do begin
s2:=s2+s^;
inc(s);
end;
if pos('Блокнот',s2)>0 then begin
Result:=1;
exit;
end;
end;
end;
end;
Result := 0;
end;

begin
HookHandle := SetWindowsHookEx(WH_SHELL, @CBTProc, HInstance, 0);
end.


Так примерно надо?..

Автор: volvo 14.09.2010 20:25

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

Цитата
Так примерно надо?..

Цитата
hshell_language по мсдн должен возвращать хэндл окна
Чего-чего он должен возвращать? Все, что в MSDN http://msdn.microsoft.com/en-us/library/ms644991%28VS.85%29.aspx - это то, что при Code = HSHELL_WINDOWCREATED, параметр wParam будет содержать хэндл окна. Получить по известному хэндлу заголовок сможешь? smile.gif Получишь заголовок, посмотри, содержится ли в нем "Блокнот", и если да - то убивай окно, потому как WH_SHELL не может отменить создание, окно уже было создано. Отменить создание через Result = ненулевое_значение можно, когда ты перехватываешь HCBT_CREATEWND. Но тогда тебе нельзя работать с заголовком окна, он еще не создан smile.gif Выбирай...

Автор: Unconnected 14.09.2010 20:31

Цитата
Отменить создание через Result = ненулевое_значение можно, когда ты перехватываешь HCBT_CREATEWND. Но тогда тебе нельзя работать с заголовком окна, он еще не создан


Я бы выбрал перехватывать HCBT_CREATEWND. В оригинале функция хорошо справлялась с завершением диалогов открытия. Но, раз хэндла нет, что мы в том случае можем получить, pid процесса?

Автор: volvo 14.09.2010 21:21

Что значит, нет Хэндла? Я где-то тебе сказал про то ,что нет хэндла? Я сказал, что на момент перехвата HCBT_CREATEWND тебе не гарантируется наличие заголовка окна. Хэндл есть всегда, он содержится в wParam:

Цитата
Code
HCBT_CREATEWND
wParam
Specifies the handle to the new window.
lParam
Specifies a long pointer to a CBT_CREATEWND structure containing initialization parameters for the window. The parameters include the coordinates and dimensions of the window. By changing these parameters, a CBTProc hook procedure can set the initial size and position of the window.


И что тебе это дало? Что будешь делать с хэндлом? Как определишь, что это именно блокнот, а не IE, скажем?

Автор: Unconnected 14.09.2010 21:27

А у меня есть хитроумная функция, которая выдаст путь к файлу по хэндлу smile.gif


uses tlhelp32;
Function HandtoPath(H: HWND): String;
Var
Pid:Cardinal;
M: TModuleEntry32;
HSnapshot: THandle;
Begin
Result:='';
GetWindowThreadProcessId(H,@Pid);
HSnapshot:=CreateToolhelp32Snapshot(TH32CS_SNAPMODULE,Pid);
If HSnapshot=-1 Then Exit;
M.DwSize:=SizeOf(TModuleEntry32);
If Module32First(HSnapshot,M) Then Result:=M.SzExePath;
CloseHandle(HSnapshot);
End;


Приблизительно получится понять, что запустилось..

Автор: volvo 14.09.2010 21:48

Цитата(Unconnected @ 14.09.2010 15:09) *
универсальность нужна..
и
Цитата(Unconnected @ 14.09.2010 17:27) *
Приблизительно получится понять, что запустилось..
это взаимоисключающие параграфы. Вот возьму я, скопирую notepad.exe в другую папку под именем SuperPuper.exe, и где будет твоя универсальность, когда эта программа запускаться будет? Там же, где и твоя хитроумная функция приблизительно smile.gif Не надо делать сложным то, что можно сделать просто. Имя класса окна вычисляется элементарно, для этого достаточно написать простенькую утилитку, и запустить один раз то приложение, которое будешь потом запрещать. Все, после этого никакие ухищрения с копированием EXE-файлов уже не проходят, приложение бракуется на другом уровне.

Дело, конечно, твое, только ты ж потом опять придешь, когда выяснится, что программа не работает как нужно, и вместо того, чтоб переписать как надо, будешь опять наворачивать на своего монстра еще и еще кода.

Автор: Unconnected 14.09.2010 22:23

И правда, по классу лучше определять.. что-то я не подумал) Тогда так:


function getclname(wnd:hwnd):string;
var
Cl:array[0..pred(MAX_PATH)] of char;
begin
GetClassName(wnd,cl,MAX_PATH);
result:=cl;
end;

function CBTProc(Code: integer; WParam: word; LParam: Integer): Longint; stdcall;
begin
if Code<0 then begin
Result := CallNextHookEx(HookHandle, code, WParam, LParam);
exit;
end;
case Code of
HCBT_CREATEWND: begin
showmessage(getclname(wparam));
end;
end;
Result := 0;
end;

begin
HookHandle := SetWindowsHookEx(WH_CBT, @CBTProc, HInstance, 0);
end;


Укоротил донельзя, а всё равно не того.

Автор: volvo 14.09.2010 22:27

Можешь прикрепить весь проект?

Автор: Unconnected 14.09.2010 22:29

Он на "любимом" KOL... smile.gif Надо? Но ловушка точно ставится, я проверял, проходит куча сообщений через неё.

И да, зеркальные классы не виноваты, я в них и с сообщениями работал, и с теми же ловушками когда-то..

added: сейчас воткнул функцию в обычный проект D2007 - то же самое.

Автор: volvo 14.09.2010 23:10

Цитата
а всё равно не того
Ну, поскольку Дельфи у меня под рукой нет, и не будет до конца недели (ну полетел у меня компьютер, где были установлены Дельфи и Билдер, да и все остальное - тоже, сейчас я на старой машине, почти пустой, из программного обеспечения - только FF + FPC /который, как выяснилось, даже DLLProc не знает, блин, поделка для первокурсников, пишущих консольные сортировалки, а не язык dry.gif ДЛЛ оформить нормально - и то не получается /), написать рабочий код не могу, а исходников не для KOL у тебя нет - буду доканывать тебя теоретическими вопросами. Ты ловишь HCBT_CREATEWND? А что, ShowMessage окно не создает по-твоему? У тебя ж зависнет все на фиг, это единственное, чего ты добьешься...

Автор: Unconnected 14.09.2010 23:19

Цитата
ДЛЛ оформить нормально - и то не получается


Какое ценное лирическое отступление! Так значит, надо именно в dll хук оформлять? Просто я помню делал глобальный хук на клаву, там это было необязательно...

Автор: volvo 14.09.2010 23:26

Хм... Надо было все-таки исходники попросить у тебя... smile.gif

Цитата
HCBT_CREATEWND

Windows вызывает хук WH_CBT с этим при создании окна. Когда хук установлен как локальный, это окно должно создаваться потоком, на который установлен хук. Хук WH_CBT вызывается до того, как Windows пошлет новому окну сообщения WM_GETMINMAXINFO, WM_NCCREATE, или WM_CREATE. Таким образом, фильтрующая функция может запретить создание окна, вернув TRUE.
DLL, конечно нужна...

Автор: Unconnected 15.09.2010 0:10

Ту би контин, блин.. Короче, такая dll:

library project1;

uses
sysutils,windows;

{$R *.res}
var hookhandle:HHook;

function getclname(wnd:hwnd):string;
var
Cl:array[0..pred(MAX_PATH)] of char;
begin
GetClassName(wnd,cl,MAX_PATH);
result:=cl;
end;

function CBTProc(Code: integer; WParam: word; LParam: Integer): Longint; stdcall;
begin
if Code<0 then begin
Result := CallNextHookEx(HookHandle, code, WParam, LParam);
exit;
end;
case Code of
HCBT_CREATEWND:begin
if pos('NOTEPAD',uppercase(getclname(wparam)))>0 then begin
result:=1;
exit;
end;
end;
end;
Result := 0;
end;

procedure LocalExitProc; far;
begin
if HookHandle<>0 then begin
UnhookWindowsHookEx(HookHandle);
end;
end;

exports CBTProc;
begin
end.



Подключаю пока самым простым образом:

function hoks(Code: integer; WParam: word; LParam: Integer): Longint; stdcall; external 'project1.dll' name 'CBTProc';
// также пробовал с таким прототипом: procedure hoks()

...

Procedure sethook;
begin
HookHandle := SetWindowsHookEx(WH_CBT, @hoks, HInstance, 0);
end;



Так надо?..

Автор: volvo 15.09.2010 1:24

Заставил ты меня все-таки написать работающий хук на FPC smile.gif ...
Вот DLL-ка:

{$mode delphi}

Library Proj;

uses
SysUtils, Windows;

var
HookHandle: HHook;

function GetClName(myWnd: HWND): String;
var
Cl: array[0 .. pred(MAX_PATH)] of char;
begin
GetClassName(myWnd, Cl, MAX_PATH);
result := cl;
end;

function CBTProc(Code: integer; myWParam: WPARAM;
myLParam: LPARAM): LRESULT; stdcall;
begin
if Code < 0 then
begin
Result := CallNextHookEx(HookHandle, code, myWParam, myLParam);
exit;
end;

case Code of
HCBT_CREATEWND:
begin
if pos('NOTEPAD', UpperCase(GetClName(myWParam))) > 0 then
begin
result := 1; exit;
end;
end;
end;

result := 0;
end;


procedure SetTheHook; stdcall;
begin
if HookHandle = 0 then
begin
HookHandle := SetWindowsHookEx(WH_CBT, @CBTProc, HInstance, 0);
end;
end;

procedure DelTheHook; stdcall;
begin
if HookHandle<>0 then
begin
UnhookWindowsHookEx(HookHandle);
end;
end;

exports
SetTheHook, DelTheHook;

end.


Вот так вызывается (это чистый WinAPI)

const
DLLName = 'proj.dll';

procedure SetTheHook; stdcall; external DLLname;
procedure DelTheHook; stdcall; external DLLname;

// ...

begin // Основной блок программы
if not WinRegister then begin
MessageBox(0, 'Register failed', nil, mb_Ok);
Exit;
end;
hWindow := WinCreate;
if longint(hWindow) = 0 then begin
MessageBox(0, 'WinCreate failed', nil, mb_Ok);
Exit;
end;

SetTheHook;

while GetMessage(@AMessage, 0, 0, 0) do begin
TranslateMessage(AMessage);
DispatchMessage(AMessage);
end;

DelTheHook;
Halt(AMessage.wParam);
end.



Любые приложения запускаются, кроме Notepad-а...

Автор: Unconnected 15.09.2010 1:34

У меня почти то же самое было, только это работает)) Я понял, надо было в основной программе сразу писать процедуру из exports, без всяких name 'CBTProc'.. Большое спасибо smile.gif Всё чаще, когда у меня какой-то затык, я лезу смотреть созданные мною темы..))

Кстати, чтобы не таскать с собой отдельно dll - только извлекать из ресурсов в нужный момент? Прилинковать как-нибудь нельзя?

Автор: volvo 15.09.2010 2:01

Цитата
Прилинковать как-нибудь нельзя?
Можно (через Project->Resources->New->User Data, а потом - извлекать через TResourceStream + SaveToFile), но не нужно. Спокойная жизнь надоела? Хочется слышать матюгание антивирусов? smile.gif

Автор: Unconnected 15.09.2010 14:49

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

Автор: Unconnected 15.09.2010 19:43

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

Function retb:integer;stdcall
begin
result:=b;
end;


Переменная b:integer=0; , описана глобально, когда ловушка что-то ловит - b присваивается число. В основной программе:

function retb:byte; stdcall; external mydlname;


Регистр названий одинаковый. В главной программе в таймере запрашиваю значение retb (интервал 100мс), но оно почему-то всегда равно 0, даже когда точно известно, что ловушка сработала..

Автор: volvo 15.09.2010 21:28

Цитата
Переменная b:integer=0; , описана глобально, когда ловушка что-то ловит - b присваивается число.
Ага, размечтался smile.gif Вот здесь посмотри, как возвращать данные из DLL в приложение: http://www.mustangpeak.net/hooks.htm (там внизу прилеплен архив с примером, который работает с MMF - Memory Mapped Files). Сегодня вечером поменяю видеоплату на своем компьютере (уже купил наконец-то smile.gif ), тогда будет проще, начнется не теоретический разговор, а практический...

Автор: Unconnected 15.09.2010 21:43

blink.gif офигеть, из-за одной переменной столько кода непонятного! Неужели не предусмотрено что-то попроще? (хотя, гугл намекает, что нет). Может, можно описать во входных параметрах SetHook(var b:integer), а потом, в процедуре, присваивать? (да, так не нужно писать программы))

Вообще, самый элегантный метод - использовать txt в качестве посредника) Сработало - создал, принял - удалил..

Автор: volvo 16.09.2010 2:22

Цитата
Вообще, самый элегантный метод - использовать txt в качестве посредника) Сработало - создал, принял - удалил..
Угу. Если получилось - удалил, ты имеешь в виду? Можно, конечно, и TXT-файлами пользоваться для обмена информацией. Но ты для начала задачу озвучь, что именно нужно тебе получать? Сколько окон было заблокировано? Сколько раз вообще вызывалась ловушка? Что именно? Может, найдем и более красивое решение

P.S. (Показать/Скрыть)

Автор: Unconnected 16.09.2010 2:28

Цитата
Сколько окон было заблокировано? Сколько раз вообще вызывалась ловушка?


Устанавливается один раз, в библиотеке массив из 5 элементов с идентефикаторами программ, нужно просто в момент отлова неугодного окна сообщать об этом основной программой, в виде переменной с её (программы) индексом.

Со строками, как мне обещали мануалы, проблем нет. По крайней мере, окна нормально определяются по строкам из массива. А вот текстовик что-то не создаётся, а messagebox появляется только наполовину - звуком, само окошко не показывается)

По-моему, здесь способ с текстовиком самый оптимальный. Именно потому, что я буду проверять в таймере его существование, а существовать он будет только при срабатывании ловушки. А почему может не получиться удалить? Права? У меня туда манифест вшит, для UAC smile.gif

Автор: volvo 16.09.2010 2:54

Если нужно просто возвращать индекс заблокированного окна, вот тебе еще один способ, навскидку (не тестировал, но явных причин не работать - не вижу, да и получше будет, чем с txt-файлами). У тебя ж хендл твоего окна не меняется после того, как ты хук установил? Вот в SetHook передавай хендл своего окна (главного окна приложения, либо какой-то формы, я не знаю, что там у тебя), а при блокировке приложения ловушкой - PostMessage этому окну, "так мол и так - заблокировано приложение <и информация о нем>", а в оконной функции своего приложения лови эти сообщения и обрабатывай как нужно. Лучше будет, чем с текстовыми файлами, да еще по таймеру заморачиваться. К таймеру бы вообще привязываться не надо.

Автор: Unconnected 16.09.2010 3:39

Вот так шлю:

const wm_user=$0400; //в библиотеке эта константа почему-то была undeclared, юнит windows есть

begin
postmessage(whan,$0400+50000,i,0);//+50000 взял, чтоб наверняка попасть в [0xC000 ; 0xFFFF].
end;


Ловлю:

function TForm1.KOLFormMessage(var Msg: tagMSG;
var Rslt: Integer): Boolean;
begin
if msg.message=WM_USER+50000 then begin
//...используем wparam
result:=false; //дальше сообщению хода нет
end;
end;


Так надо? В KOL, кстати, очень удобная система работы с сообщениями, всё в одном обработчике.

Автор: volvo 16.09.2010 3:58

Цитата
+50000 взял, чтоб наверняка попасть в [0xC000 ; 0xFFFF].
blink.gif Это еще зачем? MSDN явно говорит:
Цитата
Message numbers in the fourth range (0xC000 through 0xFFFF) are defined at run time when an application calls the RegisterWindowMessage function to retrieve a message number for a string. All applications that register the same string can use the associated message number for exchanging messages. The actual message number, however, is not a constant and cannot be assumed to be the same between different sessions.
Ты регистрировал сообщения через RegisterWindowMessage?

Я б на твоем месте все-таки использовал интервал WM_USER .. 0x7FFF, ты же фактически из своей библиотеки посылаешь сообщение своему же приложению, то есть, никаких разночтений возникнуть не должно. Вот если будешь посылать чужому приложению - тогда да, надо договариваться, что это сообщение означает... Посылай

postmessage(whan, WM_USER + 1, i, 0);

Автор: Unconnected 16.09.2010 19:02

Очевидное-невероятное, блин! Передаю в sethook хэндл:

procedure SetTheHook(h:hwnd); stdcall;
begin
whan:=h;
if HookHandle = 0 then
begin
HookHandle := SetWindowsHookEx(WH_CBT, @CBTProc, HInstance, 0);
end;
end;


Смотрю в этой процедуре h - всё верно, совпадает с хэндлом формы, параметр был передан. whan (whan:hwnd, описана глобально), соответственно, присвоено значение h. Это если смотреть сразу после присваивания, в Sethook (я смотрел путём вывода в текстовик). Но в процедуре CBTProc почему-то whan всегда равна нулю!!! На локализацию этой фигни я угрохал полдня )) (зато теперь знаю, что прототип функции действительно лучше не менять)). И вот сейчас сижу и думаю, почему глобальная переменная в одном месте нормальная, а в другом - нулевая..
Значение whan в библиотеке ТОЧНО нигде не трогается, уже всё обсмотрел..

Автор: volvo 16.09.2010 19:31

В общем, если не хочешь потерять еще три дня, и потом все-таки вернуться к тому, что я тебе написал в сообщении №25 - вернись сейчас. ТОЛЬКО MMF гарантируют тебе работу. Память должна быть общей (shared memory). Вот тебе еще один пример: http://webcache.googleusercontent.com/search?q=cache:cMFnZHZKRjAJ:www.experts-exchange.com/Programming/Languages/Pascal/Delphi/Q_22867686.html+%2BHCBT_CREATEWND+%2Bpostmessage&cd=5&hl=ru&ct=clnk (начиная со слов "this is real working example". Проверено, действительно работает). Больше прописные истины повторять не буду. Хочешь экспериментировать - экспериментируй. Как надоест - скажешь.

Автор: Unconnected 16.09.2010 21:06

Короче на данный момент я остановился на текстовике. Логика программы предполагает, что если она вообще работает, то текстовик хватит прав создать... Просто из-за одной переменной добавлять (и разбирать) кода столько, сколько наверное во всей программе нет - нерационально как-то, что ли.. Наверное, я ещё вернусь к этой теме, когда будет "рациональней"..

volvo, ещё раз спасибо за советы, без них я бы тут далеко не уехал smile.gif

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

Автор: volvo 16.09.2010 21:21

Цитата
Просто из-за одной переменной добавлять (и разбирать) кода столько, сколько наверное во всей программе нет - нерационально как-то, что ли..
blink.gif Смотри, как выглядит DLL с расшаренной памятью:
library myhook;

{ Тут было длинное предупреждение... }

uses
SysUtils, Windows, Messages;

{$R *.res}

type
PHookRec = ^THookRec;
THookRec =
record
AppWindow: HWND;
HookID: HHOOK;
end;

const
MY_MESSAGE = WM_USER + 1;
var
RHookRec: PHookRec = nil;


function GetClName(myWnd: HWND): String;
var
Cl: array[0 .. pred(MAX_PATH)] of char;
begin
GetClassName(myWnd, Cl, MAX_PATH);
result := cl;
end;

function CBTProc(Code: integer; myWParam: WPARAM;
myLParam: LPARAM): LRESULT; stdcall;
begin
if Code < 0 then
begin
Result := CallNextHookEx(RHookRec^.HookID, code, myWParam, myLParam);
exit;
end;

case Code of
HCBT_CREATEWND:
begin
if pos('NOTEPAD', UpperCase(GetClName(myWParam))) > 0 then
begin
PostMessage(RHookRec^.AppWindow, MY_MESSAGE, myWParam, 0);
result := 1; Exit;
end;
end;
end;
result := 0;
end;

procedure SetTheHook(Handle: HWND); stdcall;
begin
RHookRec^.AppWindow := Handle;
RHookRec^.HookID := SetWindowsHookEx(WH_CBT, @CBTProc, HInstance, 0);
end;
procedure DelTheHook; stdcall;
begin
UnhookWindowsHookEx(rHookRec^.HookID);
end;

{$J+}
procedure EntryPointProc(Reason: Integer);
const
hMapObject: THandle = 0;
begin
case reason of
DLL_PROCESS_ATTACH:
begin
hMapObject :=
CreateFileMapping(INVALID_HANDLE_VALUE, nil, PAGE_READWRITE, 0, SizeOf(THookRec), 'volvo_CBT');
rHookRec := MapViewOfFile(hMapObject, FILE_MAP_ALL_ACCESS, 0, 0, SizeOf(THookRec));
end;

DLL_PROCESS_DETACH:
begin
UnMapViewOfFile(rHookRec);
CloseHandle(hMapObject);
end;

DLL_THREAD_ATTACH,
DLL_THREAD_DETACH: ;
end;
end;

exports
SetTheHook, DelTheHook;

begin
DllProc := @EntryPointProc;
EntryPointProc(DLL_PROCESS_ATTACH);
end.

Сколько кода добавлено? 10 строк? smile.gif Если что - вот VCL-ный проект, который ставит хук и получает сообщение о том, что окно было заблокировано (проект с DLL-кой тоже вложен):
Прикрепленный файл  hook_test.zip ( 73.85 килобайт ) Кол-во скачиваний: 431

Автор: Unconnected 17.09.2010 19:15

Кажется понял, в библиотеке просто делается указатель на одну общую структуру, и какие-то пассы при инициализации)
Спасибо, сделал по-человечески) Только такой способ кажется не подходит для динамической подгрузки DLL? Делаю так:


type
Tsetthehook = procedure(Handle: HWND);stdcall;
Tdelthehook = procedure;stdcall;

var setthehook:TSetthehook;
delthehook:TDelthehook;
DLLInstance : THandle;

Procedure loadlib;
begin
try
DLLInstance := LoadLibrary(pchar(writepath+mydlname));
if DLLInstance = 0 then killmeplz;
@setthehook := GetProcAddress(DLLInstance, 'SetTheHook');
if @setthehook <> nil then setthehook(form1.form.handle) else killmeplz;
@delthehook := GetProcAddress(DLLInstance, 'DelTheHook');
finally
FreeLibrary(DLLInstance);
end;
end;


, и хэндлы внутри библиотеки опять обращаются в нули...

Автор: volvo 17.09.2010 19:34

Цитата
Только такой способ кажется не подходит для динамической подгрузки DLL?
Вообще-то DLL-ке все равно, как ее подгружают, хоть загрузкой процесса, хоть LoadLibrary - в любом случае работает ветка DLL_PROCESS_ATTACH. А вот чего ты творишь в программе - непонятно. Ты DLL отключаешь (FreeLibrary) ГДЕ? Сразу после того, как адреса процедур получил? Ну-ну... smile.gif

Добавлено через 5 мин.
P.S. Только что подключил через LoadLibrary:
Procedure loadlib;
begin
DLLInstance := LoadLibrary(DLLname);
if DLLInstance = 0 then ShowMessage('Cannot Load DLL')
else
begin
@setthehook := GetProcAddress(DLLInstance, 'SetTheHook');
@delthehook := GetProcAddress(DLLInstance, 'DelTheHook');
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
loadlib;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
FreeLibrary(DLLInstance);
end;

Работает, зараза smile.gif

Автор: volvo 17.09.2010 22:34

Все-таки решил добавить. Интересная и познавательная информация о написании своих DLL:
http://www.transl-gunsmoker.ru/2009/01/dllmain_05.html
, и по ссылкам оттуда:
http://www.transl-gunsmoker.ru/2009/01/dllmain.html
http://www.transl-gunsmoker.ru/2009/01/dllmain_04.html
http://www.transl-gunsmoker.ru/2009/01/dllmain_7983.html

Автор: Unconnected 17.09.2010 23:22

Цитата
Ты DLL отключаешь (FreeLibrary) ГДЕ?


Блин, ковырялся с дллами - и заснул)
И как я её только не отключаю (-ал) smile.gif Насколько понимаю, после FreeLibrary библиотека должна исчезнуть из памяти, чтобы предоставить возможность удалить саму dll. Но она что-то такой возможности не представляет, даже после завершения программы. Более того, происходит такая странная вещь - dll даёт себя удалить где-то через минуту.. Я сначала думал, что это связано с использованием string, позаменял все string на shortstring (длиннее 255 символов строк нет там), - не помогло.

Читаю Гансмокера. Кажется, затянется - в каждой статье куча перекрестных ссылок) Говорит, использование хуков при блокировке загрузчика ОС приведёт к катастрофе)

Автор: volvo 18.09.2010 0:37

Цитата
Насколько понимаю, после FreeLibrary библиотека должна исчезнуть из памяти, чтобы предоставить возможность удалить саму dll. Но она что-то такой возможности не представляет, даже после завершения программы.
Вот ты будешь смеяться, но:
Прикрепленный файл  Unit1.pas ( 1.88 килобайт ) Кол-во скачиваний: 498


прекрасно удаляет ту самую DLL-ку, которая была в прошлом проекте, только теперь она запихана в ресурсы и появляется в папке только при старте программы. После завершения - исчезает (нет, нет, не через минуту - я б столько не прождал smile.gif ). Что-то у тебя DLL не то делает, или ты мудришь с ее загрузкой. Откуда там взялись уже строки?

Цитата
И как я её только не отключаю (-ал)
А не надо ее "как только не отключать". Надо помнить, что каждый LoadLibrary или статическое подключение - это (+1) к счетчику ссылок, а каждое завершение процесса (при статическом подключении) или FreeLibrary - это (-1). До тех пор, пока счетчик этот не станет = 0, DLL выгружена не будет.

Автор: Unconnected 18.09.2010 1:25

Цитата
прекрасно удаляет ту самую DLL-ку, которая была в прошлом проекте,


Да, действительно. Мою, впрочем, тоже удаляет обычный deletefile, когда я запускаю программу простым даблкликом. Оказался виноват довольно специфичный авторан. Никогда бы на него не подумал, дошло только в ходе экспериментов. Кажется, там мой процесс с какими-то другими привилегиями запускается, что ли... Помог отказ от FreeLibrary (да, каюсь, так не надо писать программы, ну святых тоже не бывает, та же delphi, по словам Ган-блоггера)). Я нагуглил топик, где у кого-то на FreeLibrary вылетало исключение, и он в итоге убрал совсем и помогло, мне тоже помогло)

Цитата

До тех пор, пока счетчик этот не станет = 0, DLL выгружена не будет.


На одном форуме в качестве совета для принудительной выгрузки dll видел совет сделать бесконечный цикл из FreeLibrary, наверное, "пока не сдохнет" lol.gif

Ещё раз спасибо за советы, всё получилось smile.gif

Автор: Unconnected 18.09.2010 13:54

И ещё незадача.. я тут пробовал на разные приложения хук нацеливать, и заметил, что некоторые (это не антивирусы, на них не пробовал smile.gif ), когда запрещаешь их создание в хуке (result:=1), выдают звук ошибки, и вдобавок вылетает ошибка windows (отправить отчёт\не отправлять). С этим можно что-нибудь сделать?

Автор: volvo 18.09.2010 14:06

"Некоторые" - это какие, например? (желательно - из самых известных, чтоб можно было проверить) Что сообщает Системный Журнал в таком случае, из-за чего ошибка произошла?

Автор: Unconnected 18.09.2010 14:10

Например мессенджер QIP, в журнале такое: Ошибка приложения qip.exe, версия 8.0.8.1, модуль kernel32.dll, версия 5.1.2600.2180, адрес 0x0001eb33.

Автор: volvo 18.09.2010 14:14

И какой класс окна ты запрещаешь, чтоб "погасить" QIP?

Добавлено через 4 мин.
Кстати, вот тут: http://www.ms-news.net/f3289/cbtproc-hcbt_createwnd-2737174.html говорится, что подобное поведение может быть признаком не совсем правильно написанной программы:

Цитата
Well, it may be that the creator of the window didn't presume that the create could fail and it is possible that you are uncovering a bug.
В случае с QIP-ом вполне возможный вариант...

Автор: Unconnected 18.09.2010 14:32

Ну для инфиума, например - TFRMMAN (в полном названии ещё был суффикс .unicode, ну там всё равно pos используется).

Цитата

В случае с QIP-ом вполне возможный вариант...


Ага, вот и не юзай тут всякие хитроумные функции smile.gif

Автор: volvo 18.09.2010 16:26

Цитата
Ну для инфиума, например - TFRMMAN
Ага, щаззз smile.gif Ты знаешь, сколько Инфиум создает всякой гадости ДО TFrmMan.UnicodeClass? Вот лог создания окон (имена классов) при первом запуске QIP Infium (еще ничего не настроено - появляется только окно приглашения создать новый аккаунт или выбрать существующий):

madToolsMsgHandlerWindow$a28$40cf4c
madToolsMsgHandlerWindow$a28$40cf4c
TApplication
IME
TPUtilWindow
TPUtilWindow
TPUtilWindow
GDI+ Hook Window Class
IME
OleMainThreadWndClass
TPUtilWindow
TPUtilWindow
TPUtilWindow
TfrmCore.UnicodeClass
TPUtilWindow
TPUtilWindow
TPUtilWindow
TPUtilWindow
TPUtilWindow
TPUtilWindow
TPUtilWindow
TPUtilWindow
TPUtilWindow
TPUtilWindow
TPUtilWindow
TPUtilWindow
TPUtilWindow
xxxxWorker
TPUtilWindow
TPUtilWindow
TPUtilWindow
TPUtilWindow
TPUtilWindow
TfrmMan.UnicodeClass
TInfuButton.UnicodeClass
TInfuComboBox.UnicodeClass
ComboLBox
Edit
CicMarshalWndClass
MSCTFIME UI
TInfuBitBtn.UnicodeClass
TInfuEdit.UnicodeClass
TInfuCheckBox.UnicodeClass
TPUtilWindow
TPUtilWindow
TfrmNewRegWiz.UnicodeClass
TPUtilWindow
IcsWndControlWindowClass
IcsWndControlWindowClass
IME
TfrmNewRegWiz.UnicodeClass
TInfuPanel.UnicodeClass
TInfuPanel.UnicodeClass
TInfuBitBtn.UnicodeClass
TInfuBitBtn.UnicodeClass
TInfuBitBtn.UnicodeClass
TInfuBitBtn.UnicodeClass
TInfuBitBtn.UnicodeClass
TInfuBitBtn.UnicodeClass
TInfuBitBtn.UnicodeClass
TInfuBitBtn.UnicodeClass

А ты говоришь, TFrmMan... Ну, убьешь ты его, и что? smile.gif Получишь окошко QIP-а об ошибке "не могу найти хендл объекта", так? Даже пробовать не буду, ибо знаю, что так и есть. Не зря столько служебных окон создается перед главным.

Автор: Unconnected 18.09.2010 17:07

blink.gif Фигассе я наивный... А можно название программки, которая этот лог сделала? Или можно воспользоваться этим же хуком, фильтруя ClassName'ы квипа?

И чего теперь, мне атомную бомбу на всю эту толпу кидать?))

Автор: volvo 18.09.2010 17:22

Цитата
А можно название программки, которая этот лог сделала?
Я тебе лучше покажу, как DLL-ку изменить, чтоб такое лог получать, ладно? Вот функция хука (в DLL):

function CBTProc(Code: integer; myWParam: WPARAM;
myLParam: LPARAM): LRESULT; stdcall;
var
className: string;
ACopyData: TCopyDataStruct;
begin
if Code < 0 then
begin
Result := CallNextHookEx(rHookRec^.HookID, code, myWParam, myLParam);
exit;
end;

case Code of
HCBT_CREATEWND:
begin
className := GetClName(myWParam);
with aCopyData do
begin
dwData := 0;
cbData := Length(className) * SizeOf(Char);
lpData := PChar(className);
end;
SendMessage(RHookRec^.AppWindow, WM_COPYDATA, 0, LPARAM(@ACopyData));

if pos(UpperCase('notepad'), UpperCase(GetClName(myWParam))) > 0 then // или className
begin
PostMessage(RHookRec^.AppWindow, MY_MESSAGE, myWParam, 0);
result := 1; Exit;
end;
end;
end;
result := 0;
end;

, а вот так это ловится:
// в классе формы - заголовок
procedure WMCopyData(var Msg: TWMCopyData); message WM_COPYDATA;

// и реализация
procedure TForm1.WMCopyData(var Msg: TWMCopyData);
var
Info: string;
Len: Integer;
begin
Len := Msg.CopyDataStruct.cbData div sizeof(Char);
SetLength(Info, Len);
Move(Msg.CopyDataStruct.lpData^, PChar(Info)^, Len * sizeof(Char));
Memo1.Lines.Add(Info);
end;
устанавливаешь хук и запускаешь любое приложение значком быстрого вызова, который лежит на десктопе, чтоб лишние окна не создавались - получаешь список всех классов, созданных при запуске приложения.

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

Автор: Unconnected 18.09.2010 18:42

Хм.. попробовал тормозить все классы, стоящие до TfrmMan (и вместе, и по отдельности - они там повторяются, кстати) - окошко квипа так же появлялось, а если тормозить и TfrmMan - то все, багрепорт) Я вот чего думаю, поставил я хук, ведь пока сообщение не пройдет все ловушки, к квипу не придёт? Можно ведь "приостанавливать" процесс запуска, а в это время убивать процесс, хэндл-то есть... и хитроумная процедура тоже)

Добавлено через 15 мин.
Да, так получается, в принципе.. Ловлю самый первый класс и завершаю процесс. Правда, тут применяю и первую "хитроумную" процедуру, для получения пути к файлу, т.к. для завершения процесса второй хитроумной нужно знать имя exe. У любителей superqip.exe не сработает, правда.. smile.gif

Автор: volvo 18.09.2010 20:16

Цитата
Хм.. попробовал тормозить все классы, стоящие до TfrmMan (и вместе, и по отдельности - они там повторяются, кстати) - окошко квипа так же появлялось

Неправда smile.gif

      if (pos(UpperCase('tapplication'), UpperCase(GetClName(myWParam))) > 0) or
(pos(UpperCase('madToolsMsgHandler'), UpperCase(GetClName(myWParam))) > 0) or
(pos(UpperCase('madExceptWndClass'), UpperCase(GetClName(myWParam))) > 0) or
(pos(UpperCase('tfrmcore'), UpperCase(GetClName(myWParam))) > 0) then


begin
PostMessage(RHookRec^.AppWindow, MY_MESSAGE, myWParam, 0);
result := 1; Exit;
end;

Этого достаточно, чтоб убить QIP. Ну, в смысле, то окно выбора аккаунта. Тебе надо было всего навсего добавить в возвращаемую в приложение строку еще и хендл объекта и хендл его предка, и посмотреть, от чего же так зависит появление окна на экране. И кто владелец того окна, на котором заканчивается лог (и выбрасывается окно с сообщением об ошибке). Последовательно проходишь назад, уничтожая всех предков, и вот оно, чудо !!! smile.gif

Так что не надо никаких бомб, опытный снайпер с хорошей оптикой может принести гораздо больше вреда smile.gif

Автор: Unconnected 19.09.2010 3:49

Кажется, поправку на ветер забыл smile.gif У меня багрепорта теперь нет, но звук ошибки всё равно булькает.) Тоже по умолчанию выпрыгивает окно выбора аккаунта. Кстати, на единичном уничтожении tfrmcore у меня уже всё крошилось) А чем с теоретической точки зрения плох мой вариант, если не считать перенесение exe в произвольную папку?

В предыдущем посте три смайла образуют равнобедренный тупоугольный треугольник, тонко lol.gif

Автор: volvo 19.09.2010 16:53

Цитата
Можно ведь "приостанавливать" процесс запуска, а в это время убивать процесс, хэндл-то есть...
Можешь показать, как именно ты "приостанавливаешь процесс"? Где это происходит? И как именно ты убиваешь процесс? А потом я скажу, чем будет чреват такой подход, ладно? smile.gif

Автор: Unconnected 19.09.2010 17:18

//uses tlhelp32;

function KillTask(ExeFileName: string): integer;stdcall; //вроде как это из тех 10% кода из сети, который не..
const
PROCESS_TERMINATE=$0001;
var
ContinueLoop: BOOL;
FSnapshotHandle: THandle;
FProcessEntry32: TProcessEntry32;
begin
result := 0;
FSnapshotHandle := CreateToolhelp32Snapshot
(TH32CS_SNAPPROCESS, 0);
FProcessEntry32.dwSize := Sizeof(FProcessEntry32);
ContinueLoop := Process32First(FSnapshotHandle,
FProcessEntry32);
while integer(ContinueLoop) <> 0 do
begin
if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) =
UpperCase(ExeFileName))
or (UpperCase(FProcessEntry32.szExeFile) =
UpperCase(ExeFileName))) then
Result := Integer(TerminateProcess(OpenProcess(
PROCESS_TERMINATE, BOOL(0),
FProcessEntry32.th32ProcessID), 0));
ContinueLoop := Process32Next(FSnapshotHandle,
FProcessEntry32);
end;
CloseHandle(FSnapshotHandle);
end;

function CBTProc(Code: integer; myWParam: WPARAM;
myLParam: LPARAM): LRESULT; stdcall;
var i:integer;
s:string;
begin
if Code < 0 then
begin
Result := CallNextHookEx(RHookRec^.HookID, code, myWParam, myLParam);
exit;
end;
case Code of
HCBT_CREATEWND:
begin
//s:=getclname(mywparam);
sn:=uppercase(handtopath(mywparam));
for i:=1 to fc do begin
if pos(wins[i],sn)>0 then begin
PostMessage(RHookRec^.AppWindow, MY_MESSAGE,wparam(i), 0);
killtask(extractfilename(sn));
break;
end;
end;
end;
end;
result := 0;
end;


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

Автор: volvo 19.09.2010 19:44

Ну не знаю... Ловить HCBT_CREATEWND, и вместо того, чтобы просто вернуть 1 - вызывать стороннюю процедуру, которая будет уничтожать процессы через TerminateProcess (который был, кстати, создан совсем для других целей) - это как-то... Входит как раз в 90% smile.gif Да, а что насчет работы под Win64? Уверен?

Кстати, если уж TerminateProcess - то перебор всех процессов совсем не обязательно делать, достаточно:

  case Code of
HCBT_CREATEWND:
begin
if (pos(UpperCase('tfrmman'), UpperCase(GetClName(myWParam))) > 0) then
begin
PostMessage(RHookRec^.AppWindow, MY_MESSAGE, myWParam, 0);
GetWindowThreadProcessId(myWParam, PID);
TerminateProcess(OpenProcess(PROCESS_TERMINATE, BOOL(0), PID), 0);
result := 1; Exit;
end;

end;

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

Автор: Unconnected 19.09.2010 21:18

Ловить HCBT_CREATEWND, и вместо того, чтобы просто вернуть 1

Ну по сути result:=1 и терминатор делают одно и то же, только для первого надо для каждого приложения искать нужные классы, а тут раз и всё smile.gif


Цитата
Да, а что насчет работы под Win64? Уверен?


Попробовал на своей win7 home 64 - перехват работает хорошо - нужные окна виду не показывают. Но вот PostMessage, кажется, недокидывает до основной программы сообщение, но это уже наверное мой косяк.. или не мой..)

Цитата

это точно так же снесет QIP...


Легким движением руки 20 строк превращаются...)))

Ну вроде пока всё работает, спасибо smile.gif

Автор: Snake_B 20.09.2010 3:57

Цитата(volvo @ 20.09.2010 0:44) *

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


вот кстати вопросик (да и чтобы темы не плодить)...
как можно чужую иконку оттуда убрать... и как её туда вернуть?

удалить то по моему легко можно... а вот как обратно её добавить (и зарегистрировать на родную программу)...

Автор: volvo 20.09.2010 5:28

Цитата
как можно чужую иконку оттуда убрать... и как её туда вернуть?
Попробуй посмотреть вот тут: http://rouse.drkb.ru/winapi.php#fwsystrayinfo , у Rouse_ с Исходников есть пример работы с иконками для WinXP. Чтоб иметь возможность восстановить иконку, надо перед удалением запомнить где-то у себя ту иконку (одну или несколько), которые установлены нужным приложением, а потом послать приложению Shell_NotifyIcon + NIM_ADD

Автор: Snake_B 20.09.2010 5:38

Цитата(volvo @ 20.09.2010 10:28) *

Попробуй посмотреть вот тут: http://rouse.drkb.ru/winapi.php#fwsystrayinfo , у Rouse_ с Исходников есть пример работы с иконками для WinXP. Чтоб иметь возможность восстановить иконку, надо перед удалением запомнить где-то у себя ту иконку (одну или несколько), которые установлены нужным приложением, а потом послать приложению Shell_NotifyIcon + NIM_ADD


о.... спасибо... поковыряю...

> а потом послать приложению Shell_NotifyIcon + NIM_ADD
системному трею послать же?

Автор: volvo 20.09.2010 6:48

Ну да, трею, разумеется...