Привет всем

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

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.

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

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

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

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

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

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

Пошукал в 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.

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

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


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

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

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



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

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

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;

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

и
это взаимоисключающие параграфы. Вот возьму я, скопирую notepad.exe в другую папку под именем SuperPuper.exe, и где будет твоя универсальность, когда эта программа запускаться будет? Там же, где и твоя хитроумная функция приблизительно Не надо делать сложным то, что можно сделать просто. Имя класса окна вычисляется элементарно, для этого достаточно написать простенькую утилитку, и запустить один раз то приложение, которое будешь потом запрещать. Все, после этого никакие ухищрения с копированием EXE-файлов уже не проходят, приложение бракуется на другом уровне.

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

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

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;

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

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

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

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

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

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

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

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

Ту би контин, блин.. Короче, такая 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;

Так надо?..

Заставил ты меня все-таки написать работающий хук на FPC ...
Вот 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-а...

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

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

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

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

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

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

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

function retb:byte; stdcall; external mydlname;

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

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

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

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

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

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

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

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

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

Вот так шлю:

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, кстати, очень удобная система работы с сообщениями, всё в одном обработчике.

Это еще зачем? MSDN явно говорит:Ты регистрировал сообщения через RegisterWindowMessage?

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

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

Очевидное-невероятное, блин! Передаю в 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 в библиотеке ТОЧНО нигде не трогается, уже всё обсмотрел..

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

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

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

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

Смотри, как выглядит 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 строк? Если что - вот VCL-ный проект, который ставит хук и получает сообщение о том, что окно было заблокировано (проект с DLL-кой тоже вложен):
Нажмите для просмотра прикрепленного файла

Кажется понял, в библиотеке просто делается указатель на одну общую структуру, и какие-то пассы при инициализации)
Спасибо, сделал по-человечески) Только такой способ кажется не подходит для динамической подгрузки 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;

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

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

Добавлено через 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;

Работает, зараза

Все-таки решил добавить. Интересная и познавательная информация о написании своих DLL:
Несколько причин, чтобы не делать ничего страшного в своей DllMain
, и по ссылкам оттуда:
DllMain и жизнь до родов
DllMain - страшилка на ночь
Ещё причины, почему не надо делать ничего страшного в DllMain: случайная блокировка

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

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

Вот ты будешь смеяться, но:
Нажмите для просмотра прикрепленного файла

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

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

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



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

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

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

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

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

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

Добавлено через 4 мин.
Кстати, вот тут: CBTProc and HCBT_CREATEWND говорится, что подобное поведение может быть признаком не совсем правильно написанной программы:
В случае с QIP-ом вполне возможный вариант...

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


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

Ага, щаззз Ты знаешь, сколько Инфиум создает всякой гадости ДО 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... Ну, убьешь ты его, и что? Получишь окошко QIP-а об ошибке "не могу найти хендл объекта", так? Даже пробовать не буду, ибо знаю, что так и есть. Не зря столько служебных окон создается перед главным.

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

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

Я тебе лучше покажу, как 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;

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

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

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

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