endvaclass="underline" = 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.
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;
endvaclass="underline" 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;