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ąć.
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;
http://4programmers.net/faq.php?id=701 chyba łątwo bedzie na Delphi przerobic ;P
// a i kolejny przyklad tego jak niektorzy szukają :]
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
Najprościej to napisac własny serwer proxy dla stron i kazać przeglądarce przez niego się łączyć. ;)
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.