Ловушка на создание окна

← →
Cosmic (2003-02-07 18:56) [0]

Мастера! Никогда не работал с ловушками, поэтому буду очень благодарен за рабочий пример. Задача следующая: нужно поставить ловушку на создание окна, чтобы не допустить его открытия. Не искать при этом хендл, не посылать закрывающее сообщение, а просто не допустить открытия. Подскажите, пожалуйста, как...

← →
}{enon (2003-02-07 19:37) [1]

А что за окно?

← →
Cosmic (2003-02-07 21:11) [2]

"Диспетчер задач Windows" :)

← →
DVM (2003-02-07 22:47) [3]

Ловушка тут не обязательна - можно по таймеру получать список окон и искать в нем нужное.

← →
Ich Hasse (2003-02-07 23:44) [4]

2 DVM таймер нельзя, есть шанс открытия окна (пусть ненадолго)... Не ставить же ради этого Multimedia Timer

← →
Cosmic (2003-02-08 08:04) [5]

Вот и я о том же. К тому же, при открытии окна и его последующем закрытии (даже мультимедиа таймером) окно на долю секунды показывается на экране, и только потом исчезает. А мне совсем не нужно его показывать, его нужно перехватить и запретить. Кстати, "диспетчер задач" - это просто пример... :)

← →
DVM (2003-02-09 01:47) [6]

Это вот длл-ка:
*****************************************************
library Hooks;

uses
Windows,
Messages,
Procs in "Procs.pas";

function CBTProc(Code: Integer; wParam, lParam: Integer): Integer; stdcall;
begin
case Code of
HCBT_ACTIVATE: ;
HCBT_CREATEWND: ;
HCBT_MINMAX: case LoWord(LParam) of
SW_MINIMIZE: PostMessage(PProgData^.WndMain, HM_ACTION, Ord(haWindowMinimize), wParam);
end;
HCBT_SYSCOMMAND: case wParam of
SC_SCREENSAVE: ;
end;
HCBT_SETFOCUS: ;
end;
Result := CallNextHookEx(PProgData^.Hooks.CBTHook, Code, wParam, lParam);
end;

function ShellProc(Code: Integer; wParam, lParam: Integer): Integer; stdcall;
begin
if Code > HC_ACTION then case Code of
HSHELL_LANGUAGE: PostMessage(PProgData^.WndMain, HM_ACTION, Ord(haLanguage), Lo(lParam));
HSHELL_WINDOWCREATED: PostMessage(PProgData^.WndMain, HM_ACTION, Ord(haShWindowCreated), wParam); {

← →
DVM (2003-02-09 01:47) [7]

Это вот модуль к длл-ке
unit Procs;

interface

uses
Windows, Messages;

type
THooks = packed record
ShellHook: HHOOK;
CBTHook: HHOOK;

end;
TProgData = packed record
WndMain: HWND;
Hooks: THooks;
end;

const
MemFile = "{CBE83BC1-3C88-4BBE-A08D-87C6C3F95EB9}.mem";

type
THookAction = (haShWindowCreated, haShWindowDestroyed, haShWindowActivated,
haShWindowRedraw, haShGetMinRect, haShActivateShellWindow, haLanguage,
haWindowMinimize);

const
HM_ACTION = WM_USER + 1;

var
PProgData: ^TProgData = nil;
hMapFileObject: THandle = 0;

function CreateAndInitOrOpenSharedFile: Boolean;
procedure CloseSharedFile;

function GetWindowClassName(Wnd: HWND): String;

implementation

function CreateAndInitOrOpenSharedFile: Boolean;
var IsInit: Boolean;
begin
Result := False;
hMapFileObject := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE, 0, SizeOf(TProgData), MemFile);
if hMapFileObject <> 0 then begin
IsInit := (GetLastError <> ERROR_ALREADY_EXISTS);
PProgData := MapViewOfFile(hMapFileObject, FILE_MAP_ALL_ACCESS, 0, 0, 0);
Result := (PProgData <> nil);
if Result and IsInit then FillChar(PProgData^, SizeOf(TProgData), 0);
end;
end;

procedure CloseSharedFile;
begin
UnmapViewOfFile(PProgData); // Delphi 7: Must be removed!
CloseHandle(hMapFileObject);
end;

function GetWindowClassName(Wnd: HWND): String;
var Buf: array[0..1023] of Char;
begin
if GetClassName(Wnd, Buf, 1024) > 0 then Result := String(Buf) else Result := "";
end;

end.
****************************************************
Установка хука:
if CreateAndInitOrOpenSharedFile then PProgData.WndMain := Handle;
SetHooks(True);
****************************************************
Снятие хука:
if SetHooks(False) then SendMessage(HWND_BROADCAST, WM_NULL, 0, 0);
PProgData.WndMain := 0;
CloseSharedFile;
SetHooks(False);
*****************************************************
Ловля окон:

procedure TfmMain.OnHookAction(var Msg: TMessage);
begin
case THookAction(Msg.WParam) of
haShWindowCreated:
begin
...........
end;
haShWindowDestroyed:
begin
...........
end;
haShWindowRedraw:
begin
...........
end;

end;
end;

Разбирайтесь.

Ловушка на создание окна Найти похожие ветки