Текущий архив: 2006.08.27;
Скачать: CL | DM;

Вниз

Сообщение, отвечающее за изменение списка открытых окон в системе   Найти похожие ветки 

← →
__DATA__   (2006-05-05 09:24) [0]

Необходимо отследить момент, когда в системе изменяется список открытых окон. Например если закрыли окно(или программа) или открыли его. Интересуют только те окна, которые отображает системный Task Bar

---

← →
Elen ©   (2006-05-05 09:33) [1]

> __DATA__

1 вариант - Напиши программу которая ставит Хук через SetHook
2 вариант - Напиши прогу которая по таймеру проверяет какое окно сейчас активно на экране через EnumWindow
3 вариант - Научись перехватывать вызов процедуры API CreateProcess и ему подобные

---

← →
__DATA__   (2006-05-05 13:47) [2]

> [1] Elen ©   (05.05.06 09:33)


2й вариант не подходит, так как процессор грузит сильно перебор всех окон.
1й вариант пробовал так:


library Update_Winds;

uses
 Windows,
 SySUtils,
 Messages;

var
SysHook : HHook = 0;
flag : boolean = true;
Password : word = 0;
Wnd : Hwnd = 0;
ProcID: Cardinal;

procedure Update;
begin
 
end;

function LastPos(Needle: Char; Haystack: String): integer;
begin
 for Result := Length(Haystack) downto 1 do
   if Haystack[Result] = Needle then
     Break;
end;

function RegGetValue(RootKey: HKEY; Name: String; ValType: Cardinal; var PVal: Pointer; var ValSize: Cardinal): boolean;
var
 SubKey: String;
 n: integer;
 MyValType: DWORD;
 hTemp: HKEY;
 Buf: Pointer;
 BufSize: Cardinal;
 PKey: PChar;
begin
 Result := False;
 n := LastPos("\", Name);
 if n > 0 then
 begin
   SubKey := Copy(Name, 1, n - 1);
   if RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_READ, hTemp) = ERROR_SUCCESS then
   begin
     SubKey := Copy(Name, n + 1, Length(Name) - n);
     if SubKey = "" then
       PKey := nil
     else
       PKey := PChar(SubKey);
     if RegQueryValueEx(hTemp, PKey, nil, @MyValType, nil, @BufSize) = ERROR_SUCCESS then
     begin
       GetMem(Buf, BufSize);
       if RegQueryValueEx(hTemp, PKey, nil, @MyValType, Buf, @BufSize) = ERROR_SUCCESS then
       begin
         if ValType = MyValType then
         begin
           PVal := Buf;
           ValSize := BufSize;
           Result := True;
         end else
         begin
           FreeMem(Buf);
         end;
       end else
       begin
         FreeMem(Buf);
       end;
     end;
     RegCloseKey(hTemp);
   end;
 end;
end;

function RegGetDWORD(RootKey: HKEY; Name: String; Var Value: Cardinal): boolean;
var
 Buf: Pointer;
 BufSize: Cardinal;
begin
 Result := False;
 Value := 0;
 if RegGetValue(RootKey, Name, REG_DWORD, Buf, BufSize) then
 begin
   Value := PDWord(Buf)^;
   FreeMem(Buf);
   Result := True;
 end;
end;

function SysMsgProc(code : integer; wParam : word; lParam : longint) : longint; export; stdcall;
var
 windtext: array [0..255] of char;
 str:String;
begin
 Result := CallNextHookEx(SysHook, Code, wParam, lParam);
 case code of
   HCBT_ACTIVATE:
   begin
     Wnd := wParam;
     GetWindowText(Wnd, windtext, 255);
     Str:=windtext;
     Update;
   end;
   HCBT_CREATEWND:
   begin
     Str:=TCBTCreateWnd(Pointer(lParam)^).lpcs.lpszName;
     if Str="" then exit;
     if TCBTCreateWnd(Pointer(lParam)^).lpcs.hwndParent<>0 then exit;
     Wnd := wParam;
     GetWindowText(Wnd, windtext, 255);
     Update;
   end;
   HCBT_DESTROYWND:
   begin
     Str:="";
     Wnd := wParam;
     if Wnd<>0 then
       GetWindowText(Wnd, windtext, 255);
     str:=windtext;
     if windtext="" then exit;
     if Str="" then exit;
     if Length(Str)>0 then
       Update;
   end;
 end;
end;

function SetHook(Hook : Boolean) : Boolean; export; stdcall;
begin
 Result := false;
 if Hook then
 begin
   if SysHook = 0 then
     SysHook := SetWindowsHookEx(WH_CBT{WH_CALLWNDPROC}, @SysMsgProc, HInstance, 0);
   Result := (SysHook <> 0);
 end
 else
 begin
   if SysHook <> 0 then
   begin
     UnhookWindowsHookEx(SysHook);
     SysHook := 0;
     Result := true;
   end;
 end;
end;

exports
 SETHOOK index 1;
begin
 RegGetDWORD(HKEY_CURRENT_USER,"SOFTWARE\OMG_SHELL\ProcID",ProcID);
end.


Но почему-то управление процедуре Update не передается при создании нового окна в системе ...

3е Нет ли у кого примера реализации перехвата?

---

← →
Сергей М. ©   (2006-05-05 13:54) [3]

> почему-то управление процедуре Update не передается при
> создании нового окна в системе


А почему оно обязано туда передаваться ? Аргументы какие-то имеются ?

---

← →
__DATA__   (2006-05-05 14:18) [4]

SysMsgProc

При нахождении подходящего окна вызывает именно процедуру Update;

HCBT_ACTIVATE:
  begin
    Wnd := wParam;
    GetWindowText(Wnd, windtext, 255);
    Str:=windtext;
    Update;
  end;
  HCBT_CREATEWND:
  begin
    Str:=TCBTCreateWnd(Pointer(lParam)^).lpcs.lpszName;
    if Str="" then exit;
    if TCBTCreateWnd(Pointer(lParam)^).lpcs.hwndParent<>0 then exit;
    Wnd := wParam;
    GetWindowText(Wnd, windtext, 255);
    Update;
  end;
  HCBT_DESTROYWND:
  begin
    Str:="";
    Wnd := wParam;
    if Wnd<>0 then
      GetWindowText(Wnd, windtext, 255);
    str:=windtext;
    if windtext="" then exit;
    if Str="" then exit;
    if Length(Str)>0 then
     Update;


---

← →
__DATA__   (2006-05-05 14:29) [5]

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

---

← →
Сергей М. ©   (2006-05-05 14:44) [6]

Для начала возьми да посмоитри. действительно ли твоя хук-ДЛЛ внедряется во все GUI-процессы системы...

Подойдет любая утилита, позволяющая просмотреть список модулей в составе того или иного процесса в системе

---

← →
Leonid Troyanovsky ©   (2006-05-05 17:25) [7]

> __DATA__   (05.05.06 13:47) [2]

> 3е Нет ли у кого примера реализации перехвата?


http://rsdn.ru/Forum/Message.aspx?mid=574130&only=1

Т.е., WH_SHELL & HSHELL_WINDOWCREATED.
К моменту срабатывания окно уже есть.

--
Regards, LVT.

---

Страницы: 1 вся ветка

Текущий архив: 2006.08.27;
Скачать: CL | DM;

Наверх

Память: 0.49 MB
Время: 0.066 c