Blokada stron porno w IE

0

Muszę zrobić program, który uniemożliwi otwieranie stron pornograficznych w Internet Explorer. Chciałem to zrobić w taki sposób:
Mam 2 listy:
W jednej zawarte słowa kluczowe (np sex, porno), a w 2 adresy stron.
I potem jeśli w oknie IE otworzy się stronę, która zawiera w adresie coś z listy 2, lub w tytule coś z 1, to okno się zamyka. Tylko nie mam pojęcia jak pobrać adresy i tytuły okien ie i jak w razie czego je zamknąć.

0

Kawalek z mego kodu
(moze byc malo czytelny)

Function EnumWindowProc(Uchwyt:HWnd;P:Pointer):Boolean;StdCall;
Var Winname:array[0..144]of char;

Begin
 Result:=True;
  If GetWindowText(Uchwyt,WinName,144)>0 Then
  Begin
    If IsWindowVisible(Uchwyt)=True Then
      Mainfrm.ListBox1.Items.Add(StrPas(WinName))
    Else Mainfrm.ListBox2.Items.Add(StrPas(WinName))
  End;
End;

Function DetectWindow(WindowCaption:String; Const Slowa:TStrings; Const WielkoscLiter:Boolean):Boolean;
Var I:Word;
Begin
  Result:=False;
  If (Length(WindowCaption)<=2) Or (Slowa.Count=0) Then Exit;
  If Not WielkoscLiter Then WindowCaption:=UpperCase(WindowCaption);
  For I:=0 To Slowa.Count-1 Do If (Pos(Slowa.Strings[I],WindowCaption)>0) Or ((Pos(UpperCase(Slowa.Strings[I]),WindowCaption)>0) And Not WielkoscLiter) Then
  Begin
    Result:=True;
    Break;
  End;
End;

function ZabijProces(ProcessId:Integer):Boolean;
var
  Uchwyt:tHandle;
begin
  Uchwyt:=OpenProcess(PROCESS_TERMINATE,bool(0),ProcessId);
  if TerminateProcess(Uchwyt,0) then result:=true else result:=false;
  CloseHandle(Uchwyt);
end;


procedure TMainfrm.ListBox1DblClick(Sender: TObject);
var
s,m:string;
f:cardinal;
begin
for x:=0 to listbox1.Items.Count-1 do
begin
if listbox1.Selected[x]=true then
s:=listbox1.Items.Strings[x];

       //@p
end;
h:=FindWindow(nil,Pchar(s));
try
PostMessage( h, WM_close, 0, 0 );
 listbox1.Clear;
 listbox2.Clear;
 listview1.Clear;
 EnumWindows(@enumwindowproc,0);
  odswiez;
except
GetWindowThreadProcessId(h,@f);
 zabijproces(f);
 listbox1.Clear;
 listbox2.Clear;
 listview1.Clear;
 EnumWindows(@enumwindowproc,0);
  odswiez;
end;


end;


Procedure TMainfrm.Odswiez;
{----}
Var LB1,LB2,LV1:Integer; {Numery Itemów w ListBoxach}
  i: Integer;
  bContinue: BOOL;
  NewItem: TListItem;
begin
  ListView1.Items.Clear;
  aSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  aProcessEntry32.dwSize := SizeOf(aProcessEntry32);
  bContinue := Process32First(aSnapshotHandle, aProcessEntry32);
  while Integer(bContinue) <> 0 do
  begin
    NewItem := ListView1.Items.Add;
    NewItem.Caption := ExtractFileName(aProcessEntry32.szExeFile);
    NewItem.subItems.Add(IntToHex(aProcessEntry32.th32ProcessID, 4));
    NewItem.subItems.Add(aProcessEntry32.szExeFile);
    bContinue := Process32Next(aSnapshotHandle, aProcessEntry32);
  end;
  CloseHandle(aSnapshotHandle);
{--------}
  ListBox1.Items.BeginUpdate;
  ListBox2.Items.BeginUpdate;
  LB1:=ListBox1.ItemIndex;
  LB2:=ListBox2.ItemIndex;
  ListBox1.Items.Clear;
  ListBox2.Items.Clear;
  EnumWindows(@EnumWindowProc,0);
  ListBox1.Items.EndUpdate;
  ListBox2.Items.EndUpdate;
  If LB1<=ListBox1.Items.Count Then ListBox1.ItemIndex:=LB1;
  If LB2<=ListBox2.Items.Count Then ListBox2.ItemIndex:=LB2;
End;


procedure TMainfrm.ListView1DblClick(Sender: TObject);
var
  Ret: BOOL;
  PrID: Integer; // processidentifier
  Ph: THandle;   // processhandle
begin
  with ListView1 do

     begin
       PrID := StrToInt('$' + ItemFocused.SubItems[0]);
       Ph := OpenProcess(1, BOOL(0), PrID);
       Ret := TerminateProcess(Ph, 0);
       if Integer(Ret) = 0 then
         MessageDlg('Nie mozna zakonczyc "' + ItemFocused.Caption + '"',
                     mtInformation, [mbOK], 0)
       else
         ItemFocused.Delete;

   end;
end;



procedure TMainfrm.ListBox2DblClick(Sender: TObject);
var
q:string;
n:cardinal;
begin
for z:=0 to listbox2.items.count-1 do
begin
if listbox2.Selected[z]=true then
q:=listbox2.Items[z];
i:=FindWindow(nil,Pchar(q));
n:=GetWindowThreadProcessId(i,@p);
end;
try
PostMessage( i, WM_close, 0, 0 );
listview1.Clear;
odswiez;
except

zabijproces(p);
odswiez;
end;
end;

Procedure TMainfrm.timRefreshTimer(Sender: TObject);
Var
I:Word;
LiczbaOkien:Integer;
Uchwyt: THandle; //albo HWND
Begin
  Odswiez;
     For I:=0 To ListBox1.Items.Count-1 Do
   If ListBox1.Items.Count=0 Then Exit;
  For I:=0 To ListBox1.Items.Count-1 Do

  If DetectWindow(ListBox1.Items.Strings[I],Memo1.Items,Checkbox1.Checked) Then
  PostMessage(FindWindow(Nil,PChar(ListBox1.Items.Strings[I])),WM_CLOSE,1,1);

  {If DetectWindow(ListBox1.Items.Strings[I],Memo1.Items,Checkbox1.Checked) Then
begin
   // SendMessage(FindWindow(Nil,PChar(ListBox1.Items.Strings[I])),WM_CLOSE,0,0);
Uchwyt := FindWindow(Nil,PChar(Memo1.Items.Strings[I]));
if (Uchwyt <> Mainfrm.Handle) and (Uchwyt <> Application.Handle) then
begin
PostMessage(Uchwyt, WM_CLOSE,1,1);
end else begin
ShowMessage('Mnie chcesz zabić czubku');
End;
 end; }
 end;

0

http://4programmers.net/faq.php?id=701 chyba łątwo bedzie na Delphi przerobic ;P

// a i kolejny przyklad tego jak niektorzy szukają :]

0

a jak ktos ma firefoxa a nie iexplore?
a jak adres nic nie mowi ze strona zawiera tresci 'xxx' ?
lepiej pobierac nazwe okna niz adres

0

Najprościej to napisac własny serwer proxy dla stron i kazać przeglądarce przez niego się łączyć. ;)

0

taka mala dygresja
przeciez to bezsensu, zablokujesz slowo sex, porno etc. Zalozmy ze ktos wejdzie na stronke gdzie slowo wystepuje w adresie ale strona nie zawiera tresci do ktorych masz zabronic dostepu lub adres strony jest "czysty". Np zbiornik.com ;]

takimi zabezpieczeniami zajmuja sie sztaby ludzi, ktorzy zwiedzaja codziennie setki nowych stron porno i aktualizuja baze, do ktorej potem ma dostep program blokujacy klient.

1 użytkowników online, w tym zalogowanych: 0, gości: 1