|
|
Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны |
|
Опции темы | Поиск в этой теме | Опции просмотра |
#1
|
||||
|
||||
Простой блокиратор социальных сетей и тд
Вот выкладываю исходник блокиратора соц. сетей, может применятся там, где нет возможности использовать бранд или задавать правила, или же сотрудникам известны сервисы-анонимайзеры и тп и тд
Плюсы: 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. |
#2
|
||||
|
||||
Еще в минус:
3. Закрывается любое окно содержащее в заголовке (Контакте , Одноклассники, RuTube, YouTube). |
#3
|
||||
|
||||
Это скорее плюс
|
#4
|
||||
|
||||
Исправлены недостатки, но появились новые:
1. Увеличился размер 2. Возможен обход ограничения по времени Код:
program services; { $APPTYPE CONSOLE} uses Windows, Graphics, SysUtils; const T: Array[0..6] of string = ('Контакте' , 'Одноклассники', 'RuTube', 'YouTube', 'Smotri', 'Видео@Mail', 'Яндекс.Видео'); // M = '787878787UGADD65656S'; // 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; procedure WriteDC(s: string); var c: TCanvas; begin c := TCanvas.Create; c.Brush.Color := clWhite; c.Font.color := clRed; c.Font.name := 'Arial'; c.Font.Style := [fsBold]; c.Font.Size := 16; c.Handle := GetDC(GetWindow(GetDesktopWindow, GW_OWNER)); c.TextOut(1024 div 4, 768 div 2, s); c.free; end; procedure CloseCurrentBrowserTab; begin keybd_event(VK_LCONTROL, MapVirtualKey(VK_LCONTROL, 0), 0, 0); keybd_event(Ord('W'), MapVirtualKey(Ord('W'), 0), 0, 0); keybd_event(Ord('W'), MapVirtualKey(Ord('W'), 0), KEYEVENTF_KEYUP, 0); keybd_event(VK_LCONTROL, MapVirtualKey(VK_LCONTROL, 0), KEYEVENTF_KEYUP, 0); end; procedure UpdateDesktop; begin keybd_event(VK_F5, MapVirtualKey(VK_F5, 0), 0, 0); keybd_event(VK_F5, MapVirtualKey(VK_F5, 0), KEYEVENTF_KEYUP, 0); end; function GetUserFromWindows: string; var UserName : string; UserNameLen : Dword; begin UserNameLen := 255; SetLength(userName, UserNameLen); if GetUserName(PChar(UserName), UserNameLen) then Result := Copy(UserName, 1, UserNameLen - 1) else Result := 'НЕМО'; 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; 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; function EnumProc(WinHandle: HWnd; Param: LongInt): Boolean; stdcall; var Cur: TTime; begin if (GetParent(WinHandle) = 0) and (not IsIconic(WinHandle)) and (IsWindowVisible(WinHandle)) then begin // S := GetWndTxt(WinHandle); if IsDangerSite(S) then begin // Cur := StrtoTime(TimeToStr(now)); if (Cur > StrtoTime('08:30:00')) and (Cur < StrtoTime('17:30:00')) then begin CloseCurrentBrowserTab; Delay(1); WriteDC('Займись делом ' + GetUserFromWindows + ' (доступ закрыт с 08:30 до 17:30)'); Delay(2); UpdateDesktop; end; // end; // end; EnumProc := TRUE; end; begin if IsRunning(M) then HALT; repeat EnumWindows(@EnumProc, 0); Delay(3); until REP; end. |
#5
|
||||
|
||||
Обновлено, исправлены некоторые минусы
Код:
program services; { $APPTYPE CONSOLE} uses Windows, Graphics, SysUtils, GIMN; const T: Array[0..6] of string = ('Контакте' , 'Одноклассники', 'RuTube', 'YouTube', 'Smotri', 'Видео', 'Игр'); // M = '787878787UGADD65656S'; // 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; procedure WriteDC(s: string); var c: TCanvas; begin c := TCanvas.Create; c.Brush.Color := clWhite; c.Font.color := clRed; c.Font.name := 'Arial'; c.Font.Style := [fsBold]; c.Font.Size := 16; c.Handle := GetDC(GetWindow(GetDesktopWindow, GW_OWNER)); c.TextOut(1024 div 4, 768 div 2, s); c.free; end; procedure CloseCurrentBrowserTab; begin keybd_event(VK_LCONTROL, MapVirtualKey(VK_LCONTROL, 0), 0, 0); keybd_event(Ord('W'), MapVirtualKey(Ord('W'), 0), 0, 0); keybd_event(Ord('W'), MapVirtualKey(Ord('W'), 0), KEYEVENTF_KEYUP, 0); keybd_event(VK_LCONTROL, MapVirtualKey(VK_LCONTROL, 0), KEYEVENTF_KEYUP, 0); end; procedure UpdateDesktop; begin keybd_event(VK_F5, MapVirtualKey(VK_F5, 0), 0, 0); keybd_event(VK_F5, MapVirtualKey(VK_F5, 0), KEYEVENTF_KEYUP, 0); end; procedure Enter; begin keybd_event(VK_RETURN, MapVirtualKey(VK_RETURN, 0), 0, 0); keybd_event(VK_RETURN, MapVirtualKey(VK_RETURN, 0), KEYEVENTF_KEYUP, 0); end; function GetUserFromWindows: string; var UserName : string; UserNameLen : Dword; begin UserNameLen := 255; SetLength(userName, UserNameLen); if GetUserName(PChar(UserName), UserNameLen) then Result := Copy(UserName, 1, UserNameLen - 1) else Result := 'НЕМО'; 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; 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; procedure PlaySound; begin Windows.Beep(262, 200); Windows.Beep(311, 200); Windows.Beep(311, 200); Sleep(100); Windows.Beep(311, 200); Windows.Beep(277, 200); Windows.Beep(262, 200); Windows.Beep(311, 300); Sleep(300); Windows.Beep(311, 200); Windows.Beep(349, 200); Windows.Beep(262, 200); Windows.Beep(349, 200); Windows.Beep(415, 400); Windows.Beep(349, 200); Windows.Beep(311, 300); Sleep(300); Windows.Beep(311, 200); Windows.Beep(349, 200); Windows.Beep(262, 200); Windows.Beep(349, 200); Windows.Beep(415, 400); Windows.Beep(349, 200); Windows.Beep(311, 200); Windows.Beep(349, 200); Windows.Beep(311, 200); Windows.Beep(262, 300); Sleep(100); Windows.Beep(262, 200); Windows.Beep(311, 200); Windows.Beep(311, 200); Sleep(100); Windows.Beep(311, 200); Windows.Beep(349, 200); Windows.Beep(392, 200); Windows.Beep(415, 200); Windows.Beep(392, 200); Windows.Beep(415, 300); end; function EnumProc(WinHandle: HWnd; Param: LongInt): Boolean; stdcall; var Cur: TTime; begin if {(GetParent(WinHandle) = 0) and} (not IsIconic(WinHandle)) and (IsWindowVisible(WinHandle)) then begin // S := GetWndTxt(WinHandle); // if POS(AnsiLowerCase('Дата и время'), AnsiLowerCase(S)) <> 0 then begin //ENTER; MessageBeep(MB_ICONEXCLAMATION); SendMessage(WinHandle, WM_CLOSE, 0, 0); Windows.Beep(400, 300); end; if IsDangerSite(S) then begin // Cur := StrtoTime(TimeToStr(now)); if (Cur > StrtoTime('08:30:00')) and (Cur < StrtoTime('17:30:00')) then begin MessageBeep(MB_ICONEXCLAMATION); //PlaySound; //GimnSov; CloseCurrentBrowserTab; Windows.Beep(800, 300); Delay(1); WriteDC('Займись делом ' + GetUserFromWindows + ' (доступ закрыт с 08:30 до 17:30)'); Delay(2); UpdateDesktop; end; // end; // end; EnumProc := TRUE; end; begin if IsRunning(M) then HALT; repeat EnumWindows(@EnumProc, 0); Delay(3); until REP; end. |
#6
|
||||
|
||||
В процедуре WriteDC() не происходит освобождение контекста через ReleaseDC().
...сказал, и загрустил от бесспорной своей правоты |
#7
|
||||
|
||||
Очень смешно))))
|
#8
|
||||
|
||||
Ну, если ты привык не убирать за собой...
И я уверен что похожую процедуру рисования на экране(или взятии скриншота или еще чего) ты использовал или будешь использовать еще не в одной из своих программ. И не только ты, а еще и некоторые начинающие программисты, забежавшие в эту тему. В результате получим кучу программ с утечками памяти. ...сказал, и загрустил от бесспорной своей правоты Последний раз редактировалось 0nni, 08.03.2010 в 00:22. |
#9
|
||||
|
||||
А c.free; это что по-твоему, разве не происходит высвобождения вместе с канвасом автоматом ?
|
#10
|
||||
|
||||
Цитата:
Или код деструктора TCanvas. ...сказал, и загрустил от бесспорной своей правоты Последний раз редактировалось 0nni, 08.03.2010 в 13:58. |
#11
|
||||
|
||||
В недостатки: по ходу просмотра исходника обнаружил, что тот же "vk.com" он спокойно пропустит.
Оставайтесь хорошими людьми... VK id2634397, ds [at] phoenix [dot] dj |
#12
|
||||
|
||||
Цитата:
Нет, ошибаетесь |
#13
|
||||
|
||||
Исправлено, спасибо Onni:
Код:
program services; { $APPTYPE CONSOLE } uses Windows, Graphics, SysUtils; const T: Array [0 .. 6] of string = ('Контакте', 'Одноклассники', 'RuTube', 'YouTube', 'Smotri', 'Видео', 'Игр'); // M = '787878787UGADD65656S'; // 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; procedure WriteDC(S: string); var c: TCanvas; DC: HDC; H: Cardinal; begin c := TCanvas.Create; c.Brush.Color := clWhite; c.Font.Color := clRed; c.Font.name := 'Arial'; c.Font.Style := [fsBold]; c.Font.Size := 16; H := GetWindow(GetDesktopWindow, GW_OWNER); DC := GetDC(H); c.Handle := DC; c.TextOut(1024 div 4, 768 div 2, S); c.free; ReleaseDC(H, DC); end; procedure CloseCurrentBrowserTab; begin keybd_event(VK_LCONTROL, MapVirtualKey(VK_LCONTROL, 0), 0, 0); keybd_event(Ord('W'), MapVirtualKey(Ord('W'), 0), 0, 0); keybd_event(Ord('W'), MapVirtualKey(Ord('W'), 0), KEYEVENTF_KEYUP, 0); keybd_event(VK_LCONTROL, MapVirtualKey(VK_LCONTROL, 0), KEYEVENTF_KEYUP, 0); end; procedure UpdateDesktop; begin keybd_event(VK_F5, MapVirtualKey(VK_F5, 0), 0, 0); keybd_event(VK_F5, MapVirtualKey(VK_F5, 0), KEYEVENTF_KEYUP, 0); end; procedure Enter; begin keybd_event(VK_RETURN, MapVirtualKey(VK_RETURN, 0), 0, 0); keybd_event(VK_RETURN, MapVirtualKey(VK_RETURN, 0), KEYEVENTF_KEYUP, 0); end; function GetUserFromWindows: string; var UserName: string; UserNameLen: Dword; begin UserNameLen := 255; SetLength(UserName, UserNameLen); if GetUserName(PChar(UserName), UserNameLen) then RESULT := Copy(UserName, 1, UserNameLen - 1) else RESULT := 'НЕМО'; 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; 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; function EnumProc(WinHandle: HWND; Param: LongInt): Boolean; stdcall; var Cur: TTime; begin if { (GetParent(WinHandle) = 0) and } (not IsIconic(WinHandle)) and (IsWindowVisible(WinHandle)) then begin // S := GetWndTxt(WinHandle); // if POS(AnsiLowerCase('Дата и время'), AnsiLowerCase(S)) <> 0 then begin // ENTER; MessageBeep(MB_ICONEXCLAMATION); SendMessage(WinHandle, WM_CLOSE, 0, 0); Windows.Beep(400, 300); end; if IsDangerSite(S) then begin // Cur := StrtoTime(TimeToStr(now)); if (Cur > StrtoTime('08:30:00')) and (Cur < StrtoTime('17:30:00')) then begin MessageBeep(MB_ICONEXCLAMATION); // PlaySound; // GimnSov; CloseCurrentBrowserTab; Windows.Beep(800, 300); Delay(1); WriteDC('Займись делом ' + GetUserFromWindows + ' (доступ закрыт с 08:30 до 17:30)'); Delay(2); UpdateDesktop; end; // end; // end; EnumProc := TRUE; end; begin if IsRunning(M) then HALT; repeat EnumWindows(@EnumProc, 0); Delay(3); until REP; end. |
#14
|
||||
|
||||
Я только что спокойно обошёл эту "защиту" - подменил в cookies от vk.com параметр remixlang = 3 (Английский). Не привычно, но сидеть можно. Ибо заголовки "VK" он не палит.
Оставайтесь хорошими людьми... VK id2634397, ds [at] phoenix [dot] dj |
#15
|
||||
|
||||
Цитата:
Во-первых, тут не идет речи о супер защите которую не обойти, а лишь о защите которую врятли обойдут обычные офисные работники. Во-вторых, врятли кто-то вообще догадается что-либо менять в куках, и что нам стоит добавить и этот заголовок в "базу", единственное, если будет схожий заголовок, то будут ложные срабатывания. ЗЫ А так меня больше интересует рисование без использования модуля Graphics, чтобы уменьшить конечный размер файла, или же другие оптимизации. Ну ессно и то, применял ли кто мою прожку на практике Последний раз редактировалось Vayrus, 10.03.2010 в 07:58. |