Помощь - Поиск - Пользователи - Календарь
Полная версия: Хук на HCBT_CREATEWND
Форум «Всё о Паскале» > Современный Паскаль и другие языки > Делфи
Страницы: 1, 2
Unconnected
Привет всем 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
Хм. Интересно, куда подевались все вопросительные знаки? smile.gif Ты хоть один видишь? Я почему-то нет. Вопрос-то в чем?
Unconnected
В том, что код не работает как надо ) (по идее, при открытии блокнота блокнот не должен открыться).
volvo
Цитата
по идее, при открытии блокнота блокнот не должен открыться
С чего бы это? Заголовок окна Блокнота создается при обработке WM_CREATE, а хук твой срабатывает до того, как Блокноту будет выслано сообщение WM_CREATE. Пользуйся WH_SHELL-ом, а не WH_CBT.
Unconnected
Нуу.. я изменил code на WH_Shell, этого достаточно? Пока всё равно не ловит.
volvo
Цитата
этого достаточно?
Нет, конечно. Но меня посетила шальная мысль: а чего бы тебе в твоем предыдущем коде не проверять результат GetClassName? Класс окна блокнота известен: "Notepad" (и менять его, вроде, MS не собирается). Попробуй. Вот эта информация должна быть известна уже ДО отсылки приложению WM_CREATE, класс-то уже создан...
Unconnected
Дык это только в примере блокнот, может я ещё чего-нибудь запретить захочу, универсальность нужна.. 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
Цитата
может я ещё чего-нибудь запретить захочу, универсальность нужна
Вот именно потому, что нужна универсальность - тебе и надо работать с классом окна, а не с заголовком. У некоторых окон ты вообще заголовок прочесть не сможешь, к примеру, он рисуется вручную, что делать будешь? Узнавай класс окна и запрещай его создание.

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

Цитата
hshell_language по мсдн должен возвращать хэндл окна
Чего-чего он должен возвращать? Все, что в MSDN сказано - это то, что при Code = HSHELL_WINDOWCREATED, параметр wParam будет содержать хэндл окна. Получить по известному хэндлу заголовок сможешь? smile.gif Получишь заголовок, посмотри, содержится ли в нем "Блокнот", и если да - то убивай окно, потому как WH_SHELL не может отменить создание, окно уже было создано. Отменить создание через Result = ненулевое_значение можно, когда ты перехватываешь HCBT_CREATEWND. Но тогда тебе нельзя работать с заголовком окна, он еще не создан smile.gif Выбирай...
Unconnected
Цитата
Отменить создание через Result = ненулевое_значение можно, когда ты перехватываешь HCBT_CREATEWND. Но тогда тебе нельзя работать с заголовком окна, он еще не создан


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

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

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
Можешь прикрепить весь проект?
Unconnected
Он на "любимом" KOL... smile.gif Надо? Но ловушка точно ставится, я проверял, проходит куча сообщений через неё.

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

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


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

Windows вызывает хук WH_CBT с этим при создании окна. Когда хук установлен как локальный, это окно должно создаваться потоком, на который установлен хук. Хук WH_CBT вызывается до того, как Windows пошлет новому окну сообщения WM_GETMINMAXINFO, WM_NCCREATE, или WM_CREATE. Таким образом, фильтрующая функция может запретить создание окна, вернув TRUE.
DLL, конечно нужна...
Unconnected
Ту би контин, блин.. Короче, такая 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
Заставил ты меня все-таки написать работающий хук на 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
У меня почти то же самое было, только это работает)) Я понял, надо было в основной программе сразу писать процедуру из exports, без всяких name 'CBTProc'.. Большое спасибо smile.gif Всё чаще, когда у меня какой-то затык, я лезу смотреть созданные мною темы..))

Кстати, чтобы не таскать с собой отдельно dll - только извлекать из ресурсов в нужный момент? Прилинковать как-нибудь нельзя?
volvo
Цитата
Прилинковать как-нибудь нельзя?
Можно (через Project->Resources->New->User Data, а потом - извлекать через TResourceStream + SaveToFile), но не нужно. Спокойная жизнь надоела? Хочется слышать матюгание антивирусов? smile.gif
Unconnected
Простенький ксор перед добавлением в ресурсы, и после извлечения обратная операция - помогают smile.gif И потом такая тишина..)
Unconnected
Ещё вопрос, относительно "обратной связи". Мне в основной программе нужно узнавать, как там дела у ловушки, что она поймала и т.п. Но т.к. я не нашёл приём экспортирования переменных (наверное, этого вообще нельзя делать), то написал функцию, которая возвращает значение переменной. Так:

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


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

function retb:byte; stdcall; external mydlname;


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

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

P.S. (Показать/Скрыть)
Unconnected
Цитата
Сколько окон было заблокировано? Сколько раз вообще вызывалась ловушка?


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

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

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

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
Цитата
+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
Очевидное-невероятное, блин! Передаю в 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
В общем, если не хочешь потерять еще три дня, и потом все-таки вернуться к тому, что я тебе написал в сообщении №25 - вернись сейчас. ТОЛЬКО MMF гарантируют тебе работу. Память должна быть общей (shared memory). Вот тебе еще один пример: Сайт из гуглокэша (начиная со слов "this is real working example". Проверено, действительно работает). Больше прописные истины повторять не буду. Хочешь экспериментировать - экспериментируй. Как надоест - скажешь.
Unconnected
Короче на данный момент я остановился на текстовике. Логика программы предполагает, что если она вообще работает, то текстовик хватит прав создать... Просто из-за одной переменной добавлять (и разбирать) кода столько, сколько наверное во всей программе нет - нерационально как-то, что ли.. Наверное, я ещё вернусь к этой теме, когда будет "рациональней"..

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

И всё же как-то странно, зачем нужна возможность создания глобальных переменных в dll, если такие дела с ними..
volvo
Цитата
Просто из-за одной переменной добавлять (и разбирать) кода столько, сколько наверное во всей программе нет - нерационально как-то, что ли..
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-кой тоже вложен):
Нажмите для просмотра прикрепленного файла
Unconnected
Кажется понял, в библиотеке просто делается указатель на одну общую структуру, и какие-то пассы при инициализации)
Спасибо, сделал по-человечески) Только такой способ кажется не подходит для динамической подгрузки 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
Цитата
Только такой способ кажется не подходит для динамической подгрузки 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
Unconnected
Цитата
Ты DLL отключаешь (FreeLibrary) ГДЕ?


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

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

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

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


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

Цитата

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


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

Ещё раз спасибо за советы, всё получилось smile.gif
Unconnected
И ещё незадача.. я тут пробовал на разные приложения хук нацеливать, и заметил, что некоторые (это не антивирусы, на них не пробовал smile.gif ), когда запрещаешь их создание в хуке (result:=1), выдают звук ошибки, и вдобавок вылетает ошибка windows (отправить отчёт\не отправлять). С этим можно что-нибудь сделать?
volvo
"Некоторые" - это какие, например? (желательно - из самых известных, чтоб можно было проверить) Что сообщает Системный Журнал в таком случае, из-за чего ошибка произошла?
Unconnected
Например мессенджер QIP, в журнале такое: Ошибка приложения qip.exe, версия 8.0.8.1, модуль kernel32.dll, версия 5.1.2600.2180, адрес 0x0001eb33.
volvo
И какой класс окна ты запрещаешь, чтоб "погасить" QIP?

Добавлено через 4 мин.
Кстати, вот тут: CBTProc and HCBT_CREATEWND говорится, что подобное поведение может быть признаком не совсем правильно написанной программы:
Цитата
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
Ну для инфиума, например - TFRMMAN (в полном названии ещё был суффикс .unicode, ну там всё равно pos используется).
Цитата

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


Ага, вот и не юзай тут всякие хитроумные функции smile.gif
volvo
Цитата
Ну для инфиума, например - 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
blink.gif Фигассе я наивный... А можно название программки, которая этот лог сделала? Или можно воспользоваться этим же хуком, фильтруя ClassName'ы квипа?

И чего теперь, мне атомную бомбу на всю эту толпу кидать?))
volvo
Цитата
А можно название программки, которая этот лог сделала?
Я тебе лучше покажу, как 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
Хм.. попробовал тормозить все классы, стоящие до TfrmMan (и вместе, и по отдельности - они там повторяются, кстати) - окошко квипа так же появлялось, а если тормозить и TfrmMan - то все, багрепорт) Я вот чего думаю, поставил я хук, ведь пока сообщение не пройдет все ловушки, к квипу не придёт? Можно ведь "приостанавливать" процесс запуска, а в это время убивать процесс, хэндл-то есть... и хитроумная процедура тоже)

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