Bloqueando acesso a sites no IE

O programa no caso funciona sobre as URL digitadas no IE, sendo que faz a monitoração delas a cada 5 segundos, caso alguma esteja dentro da lista de palavra proibidas, ele fecha a janela e abre uma nova.

Código DFM:

object frmPrincipal: TfrmPrincipal
Left = 237
Top = 106
Width = 486
Height = 109
BorderIcons = [biSystemMenu, biMinimize]
Caption = 'Bloquear IE'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 13
object Label4: TLabel
Left = 320
Top = 35
Width = 157
Height = 16
Caption = '<- Páginas Solicitadas'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
ParentFont = False
end
object listPagSol: TListBox
Left = 0
Top = 0
Width = 313
Height = 80
ItemHeight = 13
TabOrder = 0
end
object Timer1: TTimer
Interval = 5000
OnTimer = Timer1Timer
Left = 192
Top = 32
end
end
Código .PAS

unit fPrincipal;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, ExtCtrls, ShellAPI, comobj;

const
palavrasBloqueia: string = 'msn,meebo,terra';

type
TfrmPrincipal = class(TForm)

	Timer1: TTimer;
	listPagSol: TListBox;
	Label4: TLabel;
	procedure Timer1Timer(Sender: TObject);
 private
	{ Private declarations }
 public
	{ Public declarations }
 end;

var
frmPrincipal: TfrmPrincipal;

implementation

{$R *.dfm}

function BloqueiaURL(url: string): boolean;
var

	ret: boolean;
	x: integer;
	strTemp: string;

begin
//Faz a comparação da url com as palavras q são proibidas

ret:=False;
strTemp:='';

for x:=1 to Length(palavrasBloqueia) do
begin
if ((palavrasBloqueia[x] = ',') or (x = Length(palavrasBloqueia))) then
begin

 strTemp:=Trim(strTemp);
 if Pos(strTemp,url) > 0 then
 begin
 ret:=True;
 Break;
 end
 else
 strTemp:='';
 end
	else
 strTemp:=strTemp + palavrasBloqueia[x];
	end;
BloqueiaURL:=ret;
end;

function GetUrlFromIE(Handle: THandle; List: TStringList): boolean; stdcall;

var

	hWndIE, hWndIEChild : HWND;
	Buffer : array[0..255] of Char;

begin

SendMessage(Handle, WM_GETTEXT, 255, integer(@Buffer[0]));
hWndIE:=FindWindow('IEFrame', Buffer);

if hWndIE > 0 then
begin

	hWndIEChild:=FindWindowEx(hWndIE, 0, 'WorkerW', nil);
	if hWndIEChild > 0 then
 begin
 hWndIEChild:=FindWindowEx(hWndIEChild, 0, 'ReBarWindow32', nil);
 if hWndIEChild > 0 then
 begin
 hWndIEChild:=FindWindowEx(hWndIEChild, 0, 'ComboBoxEx32', nil);
 if hWndIEChild > 0 then
 begin
 //Pega a URL e trabalha com o valor
 SendMessage(hWndIEChild, WM_GETTEXT, 255, integer(@Buffer));
 if List.IndexOf(Buffer) < 0 then
 List.Add(Buffer);
 if BloqueiaURL(LowerCase(Buffer)) then
 begin
 //Fecha a janela
 PostMessage(hWndIE,WM_CLOSE,0,0);
 //Abre nova janela
 ShellExecute(hWndIE, nil, PChar('http://www.plic-plac.com'), nil, nil, SW_SHOWNORMAL);
 end;
 end;
 end;
 end;
	end;
Result:=True;
end;

procedure TfrmPrincipal.Timer1Timer(Sender: TObject);

begin
//Será executado a cada 5 segundos

EnumWindows(@GetUrlFromIE, LParam(listPagSol.Items));
end;

end.
No exemplo coloquei três palavras apenas msn,meebo,terra, caso alguma delas seja digita ele bloqueia e abre nova janela com outra página. Lembrando que funciona somente para o IE.

Para fazer o download clique aqui !