Показать сообщение отдельно
  #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.
Ответить с цитированием