Вот выкладываю исходник блокиратора соц. сетей, может применятся там, где нет возможности использовать бранд или задавать правила, или же сотрудникам известны сервисы-анонимайзеры и тп и тд
Плюсы:
1. Невозможность завершения через диспетчер задач (так как имя Services.exe)
2. Неопытный юзверь просто проигнорирует его в списке процессов
3. Скрытная работа, не влияет на производительность системы
4. Работа через запланированные задания (прописывается вручную,
доп. параметры, туда редко кто заглядывает и редко мониторится спец прогами)
5. Маленький размер
6. Стабильная работа
Минусы:
1. Ресурс-версию лучше убрать, иначе Авира путает с каим то вирусом
2. Просто закрывает браузер, можно доработать до закрытия вкладки, лично у меня не получилось
Вроде все
Код:
program services;
{ $APPTYPE CONSOLE}
{$R vers.res}
uses
Windows;
const
T: Array[0..3] of string = ('Контакте' , 'Одноклассники', 'RuTube', 'YouTube');
//
M = '787878787UGADDS';
//
WM_CLOSE = $0010;
WM_QUIT = $0012;
var
REP: Boolean = FALSE;
S: String;
function IsRunning(Str: String): Boolean;
begin
CreateMutex(nil, FALSE, PChar(Str));
RESULT := (GetlastError = ERROR_ALREADY_EXISTS);
// CloseHandle(hMutex);//по завершению программы удалили мьютекс
end;
function AnsiLowerCase(const S: string): string;
var
Len: Integer;
begin
Len := Length(S);
SetString(Result, PChar(S), Len);
if Len > 0 then
CharLowerBuff(Pointer(Result), Len);
end;
function IsDangerSite(InStr: String): Boolean;
var
I: Integer;
begin
RESULT := FALSE;
for I := Low(T) to High(T) do
begin
if POS(AnsiLowerCase(T[i]), AnsiLowerCase(InStr)) <> 0 then
begin
RESULT := TRUE;
BREAK;
end;
end;
end;
function GetWndTxt(H: HWND): String;
var
Nm: Array[0..255] of Char;
begin
GetWindowText(H, Nm, 255);
RESULT := String(Nm);
end;
function EnumProc(WinHandle: HWnd; Param: LongInt): Boolean; stdcall;
begin
if (GetParent(WinHandle) = 0) and (not IsIconic(WinHandle)) and (IsWindowVisible(WinHandle)) then
begin
//
S := GetWndTxt(WinHandle);
if IsDangerSite(S) then
begin
PostMessage(WinHandle, WM_CLOSE, 0, 0);//quit
//SendMessage(WinHandle,WM_SYSCOMMAND,SC_CLOSE,0);
//Writeln('Closed: ' + S);
end;
//
end;
EnumProc := TRUE;
end;
procedure ProcessMessages;
var
Msg: TMsg;
begin
while true do
begin
if not PeekMessage(Msg, 0, 0, 0, PM_REMOVE) then Break;
if Msg.Message <> WM_QUIT then
begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
end;
end;
Procedure Delay(Secunds: integer);
var
i:integer;
begin
for i:=0 to Secunds * 10 do
begin
Sleep(100);
ProcessMessages;
end;
end;
begin
if IsRunning(M) then HALT;
repeat
EnumWindows(@EnumProc, 0);
Delay(3);
until REP;
end.