Рис. 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');
