Bloqueando acesso a sites no IE

[marcio.theis 3]

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 !

[S4ndr0_soad 0]

pra qual versão do IE??? eu testei aqui no 7 e nao deu...

[marcio.theis 3]

Se não me engano era com o 6.

[S4ndr0_soad 0]

ruim q eu nao tenhu o 6 aki pra testar mas no 7 notei q o FindWindowEx(hWndIEChild, 0, 'ComboBoxEx32', nil) está retornando 0, ele nem chega a chamar o BloqueiaUrl...

[michel kafury 1]

é possivel tambem usar somente a função BloqueiaURL:

 

procedure TMainForm.WebBrowser1NavigateComplete2(Sender: TObject;

const pDisp: IDispatch; var URL: OleVariant);

begin

if BloqueiaURL(LowerCase(URLs.Text)) then

begin

URLs.Text := 'http://www.ig.com.br';

FindAddress;

end;

end;

 

minha variavel:

 

palavrasBloqueia: string = 'webmessenger.msn,meebo,terra';

 

assim se eu digito no google por webmessenger ele nao bloqueia mas se eu entrar no webmessenger do site msn ai sim ele bloqueia...

 

 

 

Michel