Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате
Форум программистов > Delphi: WinAPI и системное программирование > Опять ловушки


Автор: pwl38 26.1.2005, 13:19
Здравствуйте уважаемые.
Понимаю, что тема порядочно надоела всем и есть масса литературы и ссылок по данному вопросу, но иногда нужно, чтобы кто-то объяснил простым и понятным языком или хорошим примером. Я перерыл практически весь форум и не только его, но по-видимому либо не хватает опыта, чтобы найти для себя что-то подходящее.
А вопрос самый что нинаесть жизненный - по крайней мере для меня, да и думаю другие вполне разделят мое мнение.
Дело в том, что с появлением в доме Интернет у детей сложилось катастрофическое положение в школе - думаю что я не одинок в этом!
Необходимо каким-то образом ограничить их "зависание" в И-нет, пока мы на работе.
Помогите пожалуйста получить ответ на вопрос о том, каким путем разумней сделать это.
У меня напрашивалось несколько вариантов. например
1. Запретить открытие Интернет-Эксплорера (но есть и другие броузеры, например в томже eMule);
2. Закрывать соединение(но тогда они будут лишены возможности даже просто скачивать что-то)

и т.д.

Я попробовал для начала написать что-то вроде глобального хука на WH_CBT, но у меня он работает очень странным образом. Во-первых создается ощущение, что он локальный, хотя функция перехвата лежит в DLL и срабатывает как ни странно только на одно событие - появление курсора мыши в облати приложения, вызвавшего этот хук. Скорей всего система почему-то просто не видит его.

Был-бы очень признателен за конкретный ответ, а за пример еще более.
Прошу набраться терпения и не отвечать чем-то наподобие "Этого полно в И-нет". По моему форум и существует для того, что-бы реально помогать друг другу. smile

Автор: p0s0l 26.1.2005, 18:45
Три раза прочитал, и так и не понял, что конкретно нужно smile...
Значит, нужно чтобы они могли "просто скачивать что-то" - что это значит ?
И если хотел не давать запускать браузер, то как они смогли бы что-то качать ?
Уровень умения работать с компом у детей какой ? Доступ в инет какой ?...
У тебя стоит Delphi - они могут бросить на форму TWebBrowser и шастать по инету smile
И что хотел реализовать через хук ?

Может просто сделать ежедневный лимит на объём трафика / время в инете ?

Автор: pwl38 26.1.2005, 19:06
Спасибо, что откликнулся.
Дети с программированием вообще не дружат, так что работа с Делфи исключена полностью.
Доступ в И-нет - ADSL.
А хуком хотел не давать возможности какому-либо приложению открыться. Он у меня просто не реагирует на WH_CBT. Подскажи пожалуйста, как например не давать открыться тому-же И-нет Эксплореру.
И очень интересна твоя идея насчет лимита времени. Как это можно реализовать.
Заранее спасибо.

Автор: p0s0l 26.1.2005, 20:21
Цитата
И очень интересна твоя идея насчет лимита времени.
Я так-то когда это говорил подразумевал Dialup smile, а насчет ADSL - фиг знает, с ним никогда не сталкивался smile
Сам можешь поэкспериментировать... Есть ли RAS-подключение ? Можно было бы смотреть статистику подключения (трафик). Если есть, то можно ли его отрубать (RasHangUp) ?... (возможно смешные вопросы задаю smile )...
У нас тут Snowy говорил, работал с RAS'ами, надо его спросить...

Цитата
А хуком хотел не давать возможности какому-либо приложению открыться. Он у меня просто не реагирует на WH_CBT. Подскажи пожалуйста, как например не давать открыться тому-же И-нет Эксплореру.
Тогда это лучше делать не так... Браузеры регистрируют свои окна в системе, и их можно найти через IShellWindows. Поэтому, имхо, более лучший в твоём случае вариант был бы такой:
Создаёшь IShellWindows:
Код
uses SHDocVw;

var  isw : IShellWindows;

procedure TForm1.FormCreate (Sender : TObject);
begin
 isw := CoShellWindows.Create;
end;

Через IShellWindows в таймере (к примеру, раз в 1 сек) смотришь, есть ли IE-окна в системе:
Код
procedure TForm1.Timer1Timer (Sender : TObject);
begin
 if isw.Count > 0 then DestroyBrowser;
end;

Если есть браузер - прибиваешь:
Код

procedure DestroyBrowser;
var
 wb2 : IWebBrowser2;
 h : THandle;
 PID : DWORD;
begin
 wb2 := isw.Item(0) as IWebBrowser2;
 GetWindowThreadProcessId (wb2.HWND, PID);
 h := OpenProcess (PROCESS_TERMINATE, False, PID);
 TerminateProcess (h, 0);
 CloseHandle(h);
end;

Против Оперы (и других браузеров на своём движке) это не пойдёт, но в случае IE поможет...

Автор: <Spawn> 28.1.2005, 06:03
pwl38 Приведи код хука, а так же скажи название винды, в котором ты его запускаешь. У меня в свое время все прекрасно работало.

Автор: pwl38 28.1.2005, 12:01
Windows XP.

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

Код


library hdll;

uses Windows, Messages;

var

 h: THandle;
 Len: Integer;
 Capt: String;

function CBTProc(
          code: integer; wParam: word; lParam: longword): longword; stdcall;
begin
    if Code < 0 then
    begin
         Result:= CallNextHookEx(H,code,wParam,lparam);
         exit;
    end;
    if Code = HCBT_CREATEWND  then
    begin
        GetWindowText(wParam, @Capt, Len);
        SetLength(Capt, Len);
        if Capt = 'Microsoft Internet Explorer' then
            Result:= 1;         // закрываем эксплорер
        else
            Result:=  0;
    end;
    CallNextHookEx(H,code,wParam,lparam);
end;

procedure SetHook; stdcall;
begin
   h:=SetWindowsHookEx(WH_CBT, @CBTProc, hInstance, 0);
end;

exports
       SetHook;
   
end.

Автор: <Spawn> 28.1.2005, 12:52
1)
Цитата
GetWindowText(wParam, @Capt, Len);


Это не будет работать, так как Capt у тебя является строкой и как минимум что нужно сделать это задать ее размер до вызова функции, так как функция GetWindowText не изменят размер буфера. Можешь попробовать так:

Код
const
 CAPTION_LEN = 256;
var
 Caption: array[0..CAPTION_LEN - 1] of Char;

GetWindowText(wParam, @Caption[0], CAPTION_LEN);


Обработчик хука тоже не совсем верный - измени на такой:

Код
   if Code = HCBT_CREATEWND  then
   begin
       //Тут получаешь заголовок окна
       if Capt = 'Microsoft Internet Explorer' then
       begin
           Result:= 1;         // закрываем эксплорер
           CallNextHookEx(H, code, wParam, lParam);
           Exit;
       end;
   end;
   Result := CallNextHookEx(H,code,wParam,lparam);

Автор: pwl38 28.1.2005, 15:05
Спасибо тебе, но суть то не в этом.
Дело в том что я вообще никогда не попадаю дальше

Код

if Code = HCBT_CREATEWND  then


Параметр Code на входе в фунцию ловушки вседа 5 или 6, но никак не 3(это HCBT_CREATEWND).

Думаю, что мою ДЛЛ другие процессы просто не видят.

Здесь p0s0l мне помог решить вопрос с закрытием Эксплорера, я это сделал (работающий код потом выложу, если кому интересно), но мне хочется понять, почему у меня не работает ДЛЛ. smile

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

Автор: <Spawn> 28.1.2005, 20:27
Не знаю, почему у тебя не работает. Вот на всякий случай код, который работает у меня(будет работать от вин 9x до 2003). Проверял для окна класса TForm, так как некогда искать класс Explorer-а(В крайнем случае можешь завязать на названии окна, но я бы так делать не стал)smile

Код

library cbt_hook;

uses
 SysUtils,
 Windows,
 UCBT_HOOK;

exports
SetHook,
FreeHook;

begin
end.


Код

unit UCBT_HOOK;

interface

uses
 SysUtils,
 Windows,
 Classes;

const
  DataSize=SizeOf(Integer);
  PROGRAM_CLASS_NAME = 'TForm1';

var
hHook:PHandle;
hMapFile:THandle;

function SetHook:Boolean; stdcall;
function FreeHook:Boolean; stdcall;

implementation

function CBTProc(Code: integer; wParam: Integer; lParam: Integer): longint; stdcall;
var
 ClassName: array[0..255] of AnsiChar;
begin
 Result := 0;
 if Assigned(hHook) then
 begin
   if code < 0 then
   begin
     Result:=CallNextHookEx(hHook^, Code, wParam, lParam);
     Exit;
   end;

   if Code = HCBT_CREATEWND then
   begin
     GetClassName(wParam, ClassName, 256);

     if (AnsiCompareStr(ClassName, PROGRAM_CLASS_NAME) = 0) then
     begin
       Result:=1;
       CallNextHookEx(hHook^, Code, wParam, lParam);
       Exit;
     end;
   end;

   Result:=CallNextHookEx(hHook^, Code, wParam, lParam);
 end;
end;

function SetHook:Boolean; export; stdcall;
begin
 Result:=False;
 if Assigned(hHook) then
 begin
   hHook^:= SetWindowsHookExA(WH_CBT, @CBTProc, hInstance, 0);
   Result:= hHook^ <> 0;
 end;
end;

function FreeHook:Boolean; export; stdcall;
begin
 Result:=False;
 if Assigned(hHook) then
   Result:= UnhookWindowsHookEx(hHook^);
end;

initialization
 hMapFile:=CreateFileMapping(INVALID_HANDLE_VALUE, nil, PAGE_READWRITE,
                              0, DataSize, 'hHookHandleName');
 if hMapFile = 0 then
    raise Exception.Create('Error MMF Handle');
 hHook:=MapViewOfFile(hMapFile, File_Map_Write, 0, 0,
                      DataSize);

finalization
 UnMapViewOfFile(hHook);
 CloseHandle(hMapFile);

end.


Поменяй тут лишь значение костанты PROGRAM_CLASS_NAME на нужное тебе.

Powered by Invision Power Board (http://www.invisionboard.com)
© Invision Power Services (http://www.invisionpower.com)