Delphi. Учимся на примерах

Парижский Сергей Михайлович

Шутка №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');