Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Разное > Исходники и статьи
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 13.02.2010, 23:10
Аватар для Vayrus
Vayrus Vayrus вне форума
Исполняемый Ретровирус
 
Регистрация: 09.08.2008
Адрес: Umbrella Corporation
Сообщения: 743
Репутация: 1293
Лампочка Простой блокиратор социальных сетей и тд

Вот выкладываю исходник блокиратора соц. сетей, может применятся там, где нет возможности использовать бранд или задавать правила, или же сотрудникам известны сервисы-анонимайзеры и тп и тд

Плюсы:
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  
Старый 15.02.2010, 16:49
Аватар для pesi
pesi pesi вне форума
Активный
 
Регистрация: 12.09.2008
Сообщения: 275
Репутация: 43
По умолчанию

Еще в минус:
3. Закрывается любое окно содержащее в заголовке (Контакте , Одноклассники, RuTube, YouTube).
Ответить с цитированием
  #3  
Старый 15.02.2010, 17:37
Аватар для Vayrus
Vayrus Vayrus вне форума
Исполняемый Ретровирус
 
Регистрация: 09.08.2008
Адрес: Umbrella Corporation
Сообщения: 743
Репутация: 1293
Лампочка

Это скорее плюс
Ответить с цитированием
  #4  
Старый 27.02.2010, 10:28
Аватар для Vayrus
Vayrus Vayrus вне форума
Исполняемый Ретровирус
 
Регистрация: 09.08.2008
Адрес: Umbrella Corporation
Сообщения: 743
Репутация: 1293
Лампочка

Исправлены недостатки, но появились новые:
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  
Старый 07.03.2010, 20:19
Аватар для Vayrus
Vayrus Vayrus вне форума
Исполняемый Ретровирус
 
Регистрация: 09.08.2008
Адрес: Umbrella Corporation
Сообщения: 743
Репутация: 1293
Лампочка

Обновлено, исправлены некоторые минусы

Код:
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  
Старый 07.03.2010, 22:40
Аватар для 0nni
0nni 0nni вне форума
Начинающий
 
Регистрация: 13.12.2008
Адрес: Туапсе
Сообщения: 161
Репутация: 20
По умолчанию

В процедуре WriteDC() не происходит освобождение контекста через ReleaseDC().
__________________
...сказал, и загрустил от бесспорной своей правоты
Ответить с цитированием
  #7  
Старый 07.03.2010, 23:23
Аватар для Vayrus
Vayrus Vayrus вне форума
Исполняемый Ретровирус
 
Регистрация: 09.08.2008
Адрес: Umbrella Corporation
Сообщения: 743
Репутация: 1293
Лампочка

Очень смешно))))
Ответить с цитированием
  #8  
Старый 08.03.2010, 00:12
Аватар для 0nni
0nni 0nni вне форума
Начинающий
 
Регистрация: 13.12.2008
Адрес: Туапсе
Сообщения: 161
Репутация: 20
По умолчанию

Ну, если ты привык не убирать за собой...
И я уверен что похожую процедуру рисования на экране(или взятии скриншота или еще чего) ты использовал или будешь использовать еще не в одной из своих программ. И не только ты, а еще и некоторые начинающие программисты, забежавшие в эту тему. В результате получим кучу программ с утечками памяти.
__________________
...сказал, и загрустил от бесспорной своей правоты

Последний раз редактировалось 0nni, 08.03.2010 в 00:22.
Ответить с цитированием
  #9  
Старый 08.03.2010, 12:18
Аватар для Vayrus
Vayrus Vayrus вне форума
Исполняемый Ретровирус
 
Регистрация: 09.08.2008
Адрес: Umbrella Corporation
Сообщения: 743
Репутация: 1293
Лампочка

А c.free; это что по-твоему, разве не происходит высвобождения вместе с канвасом автоматом ?
Ответить с цитированием
  #10  
Старый 08.03.2010, 13:51
Аватар для 0nni
0nni 0nni вне форума
Начинающий
 
Регистрация: 13.12.2008
Адрес: Туапсе
Сообщения: 161
Репутация: 20
По умолчанию

Цитата:
Сообщение от Vayrus
А c.free; это что по-твоему, разве не происходит высвобождения вместе с канвасом автоматом ?
Могу порекомендовать заглянуть в диспетчер задач:


Или код деструктора TCanvas.
__________________
...сказал, и загрустил от бесспорной своей правоты

Последний раз редактировалось 0nni, 08.03.2010 в 13:58.
Ответить с цитированием
  #11  
Старый 08.03.2010, 13:53
Аватар для PhoeniX
PhoeniX PhoeniX вне форума
Always hardcore!
 
Регистрация: 04.03.2009
Адрес: СПб
Сообщения: 3,239
Версия Delphi: GCC/FPC/FASM
Репутация: 62149
По умолчанию

В недостатки: по ходу просмотра исходника обнаружил, что тот же "vk.com" он спокойно пропустит.
__________________
Оставайтесь хорошими людьми...
VK id2634397, ds [at] phoenix [dot] dj
Ответить с цитированием
  #12  
Старый 08.03.2010, 18:45
Аватар для Vayrus
Vayrus Vayrus вне форума
Исполняемый Ретровирус
 
Регистрация: 09.08.2008
Адрес: Umbrella Corporation
Сообщения: 743
Репутация: 1293
Лампочка

Цитата:
Сообщение от DJ PhoeniX
В недостатки: по ходу просмотра исходника обнаружил, что тот же "vk.com" он спокойно пропустит.

Нет, ошибаетесь
Ответить с цитированием
  #13  
Старый 08.03.2010, 18:57
Аватар для Vayrus
Vayrus Vayrus вне форума
Исполняемый Ретровирус
 
Регистрация: 09.08.2008
Адрес: Umbrella Corporation
Сообщения: 743
Репутация: 1293
По умолчанию

Исправлено, спасибо 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  
Старый 09.03.2010, 23:14
Аватар для PhoeniX
PhoeniX PhoeniX вне форума
Always hardcore!
 
Регистрация: 04.03.2009
Адрес: СПб
Сообщения: 3,239
Версия Delphi: GCC/FPC/FASM
Репутация: 62149
По умолчанию

Я только что спокойно обошёл эту "защиту" - подменил в cookies от vk.com параметр remixlang = 3 (Английский). Не привычно, но сидеть можно. Ибо заголовки "VK" он не палит.
__________________
Оставайтесь хорошими людьми...
VK id2634397, ds [at] phoenix [dot] dj
Ответить с цитированием
  #15  
Старый 10.03.2010, 07:52
Аватар для Vayrus
Vayrus Vayrus вне форума
Исполняемый Ретровирус
 
Регистрация: 09.08.2008
Адрес: Umbrella Corporation
Сообщения: 743
Репутация: 1293
Лампочка

Цитата:
Сообщение от DJ PhoeniX
Я только что спокойно обошёл эту "защиту" - подменил в cookies от vk.com параметр remixlang = 3 (Английский). Не привычно, но сидеть можно. Ибо заголовки "VK" он не палит.

Во-первых, тут не идет речи о супер защите которую не обойти, а лишь о защите которую врятли обойдут обычные офисные работники.
Во-вторых, врятли кто-то вообще догадается что-либо менять в куках, и что нам стоит добавить и этот заголовок в "базу", единственное, если будет схожий заголовок, то будут ложные срабатывания.

ЗЫ
А так меня больше интересует рисование без использования модуля Graphics, чтобы уменьшить конечный размер файла, или же другие
оптимизации. Ну ессно и то, применял ли кто мою прожку на практике

Последний раз редактировалось Vayrus, 10.03.2010 в 07:58.
Ответить с цитированием
Ответ


Delphi Sources

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 21:41.


 

Сайт

Форум

FAQ

RSS лента

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2023

ВКонтакте   Facebook   Twitter