Хук на HCBT_CREATEWND Опции

[Unconnected]

Привет всем

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

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.

Сообщение отредактировано: Unconnected - 13.09.2010 23:13

[volvo]

Ну для инфиума, например - TFRMMAN

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