Arial Century Courier Georgia Tahoma Verdana Times New Roman
-
+
Шутка №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');