Язык delphi довольно мощный язык программирования. С его помощью можно создавать приложения различной сложности. Начиная от простейших текстовых редакторов заканчивая сложными 3d-играми. Но сейчас речь пойдёт не совсем об этом, постараемся рассмотреть разные возможности delphi. В этой статье мы взглянем на несколько различных примеров, которые нельзя отнести не к одной из отдельных тем программирования. Однако,от этого эти они не станут хуже или лучше, а просто рассмотрим темы, на которые довольно редко пишут статьи. Возможны вы даже получите больше полезной информации, чем при прочтении статьи на конкретной тему.
И назовем эту статью Шутки в delphi, прочтя её вы сможете не только подшутить при помощи компьютера над кем угодно, но, надеюсь узнаете и новое по работе с операционной системой windows. Ведь. для того что бы написать хорошую шутку надо не только обладать хорошей фантазией, но и представлять как это реализовать программно. Вот сейчас я и покажу несколько примеров шуток, которые смогут вас подтолкнуть на написание своих шуточных программ.
Ну что ж, от слов перейдём к делу.
Шутки при помощи системного реестра.
Пожалуй, шутки из этого раздела будут самыми легко осуществимыми. Здесь не надо владеть какими-то сложными техниками программирования, достаточно просто уметь обращаться с реестром из delphi.Да и даже если вы не умеете это делать, то скорее всего поймёте, тем более первый пример подробно описан. Однако, сразу же хочу предупредить если у пользователя, над которым хотите подшутить нет администраторских прав, то ничего не получиться потому что windows xp и другие из семейства nt разрешают редактировать реестр только пользователям
с наивысшими правами.
И первой шуткой которую мы рассмотрим будет пример, который я назвал Не выключаемая Винда".
"Не выключаемая Винда"
В реестре windows можно редактировать практически все настройки системы, однако зачастую эти параметры нигде не афишируются и не доступны широкой публики.
Итак, для того что лишить лучшего друга или подругу возможности выключить любимый windows достаточно добавить всего одну или две записи записи (на ваше усмотрение) в системный реестр по адресу hkey_current_usersoftwaremicrosoftwindowscurrentversionpoliciesexplorer. Если добавить туда параметр noclose равный единице, то пользователь лишиться возможности выключить компьютер, а запись nologoff (тоже равная 1) не даст пользователю сменить профиль, однако последний параметр не работает в xp.
И так посмотрим как же это сделать при помощи delphi. Как я уже говорил, глубокие знание вам сейчас не понадобятся, но для тех кто встретился с работой с реестром первый рас всё же расскажу как это работает. Но для начала приведу код, что бы было легче разбирать.
Листинг 1. "Не выключаемая Винда"
procedure tform1.nocloseclick(sender: tobject);
var
reg: tregistry;
begin
reg:=treginifile.create();
reg.rootkey:=hkey_current_user;
reg.openkey('softwaremicrosoftwindowscurrentversionpoliciesexplorer', true);
reg.writeinteger('noclose', 1);
reg.writeinteger('nologoff', 1);
reg.free;
end;
Для того что бы код заработал нормально нам понадобиться в разделе uses добавить модуль registry и поставить на форму всего одну кнопку (я назвал её noclose). После чего создать обработчик события onclick для этой кнопки и написать туда приведённый выше код.
Вначале мы объявляем переменную reg типа tregistry именно её мы будет использовать для доступа к реестру. Далее мы её инициализируем. Это значит что мы выделяем память под объект. Следующей строкой мы меняем ключевую ветку регистра на hkey_current_user; по умолчанию параметр rootkey равен hkey_local_machine. Далее следует участок кода:
Листинг 2.
reg.openkey('softwaremicrosoftwindowscurrentversionpoliciesexplorer',
true);
reg.writeinteger('noclose', 1);
reg.writeinteger('nologoff', 1);
Здесь мы открываем ключ 'softwaremicrosoftwindowscurrentversionpoliciesexplorer' и если такой ключ ещё не создан в реестре, что маловероятно, то создаём его. И после чего добавляем две записи noclose и nologoff, о которых уже говорилось выше.
Последняя строчка кода освобождает память выделенную под переменную reg. Хотя компилятор и сам должен высвобождать память используемую для локальных переменных, но лучше перестраховаться и сделать это самому, чем в итоге получить постоянно зависающее приложение.
Отключаем alt+ctrl+del.
Для того что бы быть уверенным в том что пользователь не отключить вашу шуточную программу при помощи клавиш alt+ctrl+del. необходимо хорошо спрятать приложение или... отключить диспетчер задач. Тем более, что отключить его намного проще чем полностью скрыться от "всевидящей" программы и делается это ни чуть не сложнее, чем в прошлом примере.
За активность taskmanager'a отвечает параметр disabletaskmgr, который находиться в ключе hkey_current_usersoftwaremicrosoftwindowscurrentversionpoliciessystem. Если он равен единице, то вместо Диспетчера задач, при нажатии alt+ctrl+del увидят сообщение о том что "Всемогущая утилита" отключена их администратором.
А теперь покажу как реализовать это на delphi, хотя вы наверно и сами догадались:
Листинг 3. Отключаем alt+ctrl+del.
procedure tform1.disablealtctrldelclick(sender: tobject);
var
reg: tregistry;
begin
reg:=treginifile.create();
reg.rootkey:=hkey_current_user;
reg.openkey('softwaremicrosoftwindowscurrentversionpoliciessystem', true);
reg.writeinteger('disabletaskmgr', 1);
reg.free;
end;
Работает этот код точно также как и в предедушем случае.
Сейчас мы рассмотрели два вида запретов, однако их несколько больше. Список того, что известно мне перечислен ниже.
hkey_current_usersoftwaremicrosoftwindowscurrent versionpoliciesexplorer
Меню "Пуск"
norecentdocsmenu - Скрыть "Документы"
nofavoritesmenu - Скрыть "Избранное"
nofind Скрыть - "hайти"
nohelp Скрыть - "Справка"
norun Скрыть - "Выполнить"
noclose Скрыть - "Завершение работы"
nologoff Скрыть - "Завершение сеанса"
nowindowsupdate - скрыть "windows update"
nostartmenusubfolders - скрыть подкаталоги
nosetfolders - скрыть "настройка"
nocommongroups - скрыть "Программы"
nochangestartmenu - запретить контекстное меню в меню "Пуск"
notraycontextmeny - запретить контекстное меню для панели задач
nosettaskbar - запретить настройку Панели задач
Меню "Пуск", подменю "настройка"
nosetactivedesktop - Скрыть Рабочий стол active desktop
nosetfolders - скрыть "Принтеры" и "Панель управления"
nosettaskbar - скрыть Панель задач и меню "Пуск"
nonetworkconnections - скрыть "Удаленный доступ к сети"
Меню "Пуск", подменю "Документы"
norecentdocshistory - не помнить недавно открытых документов
maxrecentdocs - количество недавно открытых документов
clearrecentdocsonexit - Очистить список недавно открытых документов при выходе
nosmdocs - скрыть "Мои документы"
nosmmypictures - скрыть "Мои рисунки"
Меню "Пуск", подменю "настройка", пункт "Принтеры"
noprintertabs - скрыть некоторые вкладки в диалоге "Свойства": принтер
nodeleteprinter - запретить удаление принтера.
noaddprinter - запретить добавление принтера.
Рабочий стол
nodesktop - Отключить Рабочий стол
classicshell - Сделать вид похожим на win 95
nointerneticon - Скрыть значок "Интернет"
nonethood - Скрыть "Сетевое Окружение"
nostartbanner - Отключить "начните работу с нажатия этой кнопки"
noactivedesktop - Отключить active desktop
noactivedesktopchanges - Запретить изменения на active desktop
Разное
nosavesettings Запретить сохранение установок
nodrives Скрыть все диски в Мой компьютер (ff ff ff ff). В зависимости от
значения скрываются разные буквы
дисков, 00 00 00 00 - не скрыт ни один.
Панель управления, диалог Сеть
hkey_current_usersoftwaremicrosoftwindowscurrentversionpoliciesnetwork
nonetsetup - Диалог Сеть недоступен.
nonesetupidpage - Вкладка Идентификация недоступна.
nonetsetupsecuritypage - Вкладка Управление доступом недоступна.
noentirenetwork - Скрыть Вся сеть
noworkgroupscontents - Скрыть содержимое сети
Панель управления, диалог Пароли
hkey_current_usersoftwaremicrosoftwindowscurrentversionpoliciessystem
noseccpl - Диалог Пароли недоступен.
nopwdpage - Вкладка Смена паролей недоступна.
noadminpage - Вкладка Удалённое администрирование недоступна.
noprofilpage - Вкладка Профили пользователей недоступна.
Панель управления, диалог Система
nodevmgrpage Вкладка Устройства недоступна.
noconfigpage Вкладка Профили оборудования недоступна.
nofilesyspage Кнопка Файловая система на вкладке Быстродействие
недоступна.
novirtpage Кнопка Виртуальная память на вкладке Быстродействие недоступна.
Панель управления, диалог Экран
nodispcpl - Диалог Экран недоступен
nodispappearancepage - Вкладка Оформление недоступна
nodispbackgroundpage - Вкладка Фон недоступна
nodispscrsavepage - Вкладка Заставка недоступна
nodispsettingspage - Вкладка настройка недоступна
Из этого списка вы можете выбрать хоть всё и ваш приятель или неприятель будет сидеть за ОС, в которой практически нечего нельзя делать.
windows который хочет всё время чего-то удалить.
Наверно каждый пользователь windows видел и пользовался атлетом Установка и удаление программ", но далеко не каждый задумывался откуда эти данные берутся. Дак, вот они тоже охраняться в реестре в ключеhkey_local_machinesoftwaremicrosoftwindowscurrentversionuninstall. В этом ключе располагаются дочерние узлы в которых и находятся данные о установленных программах. В том числе и путь к деинсталятору программы. Сейчас я покажу как получить эти данные, а потом от лица windows предложить пользователю удалить какую-либо программку.
Как обычно сначала код, а потом его объяснение:
Листинг 4. windows который хочет всё время чего-то удалить.
procedure tform1.deleteahyprogclick(sender: tobject);
var
i: integer;
buf: array[0..1000] of char;
keyhandle: hkey;
begin
timer1.enabled:=true;
keys:=tstringlist.create;
if regopenkey(hkey_local_machine,
'softwaremicrosoftwindowscurrentversionuninstall',
keyhandle)=error_success then
begin
i:=0;
while regenumkey(keyhandle, i, buf, sizeof(buf))=error_success do
begin
keys.add(strpas(buf));
i:=i+1;
end;
end;
end;
Здесь я решил немного разнообразить нашу жизнь и использовал методы winapi, они не намного сложней, зато работать с ними куда интересней. Но предварительно я объявил глобальную переменную keys типа tstringlist и инициализировал её в самом начале и локальную переменную keyhandle типа hkey, где будет храниться указатель на открытый ключ реестра.
Первая winapi функция, которую будем вызывать есть regopenkey, в неё надо передать три параметра:
1)Ветка регистра, в которой будем открывать нужный нам ключ, передаём туда
hkey_local_machine;
2)Ключ который будем открывать
3)Указатель на открытый ключ
Функция вернёт error_success, если ключ открыт успешно. Довольно странно, что константу назвали таким образом, по-началу это меня смущало, но потом быстро привык. Далее запускаем цикл пока есть не обработанные элементы в открытом ключе. Для этого используем функцию regenumkey и опять возвращаемый результат сравниваем с error_success, как только переберем все дочерние ключи функция вернёт другое значение и цикл остановиться.
Сама функция имеет четыре параметра:
1)Указатель на открытый ключ. Его мы получили при использовании функции regopenkey и находиться он в переменной keyhandle
2)Номер дочернего ключа
3)Переменная куда будет записано название дочернего ключа
4)Размер переменной buf, куда запишем результат
Остальное должно быть понятно поэтому перехожу к дальнейшему описанию.
Ещё поставил на форму один таймер по которому будет происходить вызов программы удаления, свойству time присвоил 120000мс или 2 минуты и для события ontimer написал следующий код:
Листинг 5. windows который хочет всё время чего-то удалить.
var
reg: tregistry;
key: string;
index: integer;
begin
randomize;
reg:=treginifile.create();
reg.rootkey:=hkey_local_machine;
index:=random(keys.count+1);
reg.openkey('softwaremicrosoftwindowscurrentversionuninstall'+keys[index],
true);
key:=reg.readstring('uninstallstring');
if key<>''then
begin
messagebox(0, 'do you want to delete any programm?', 'ms windows',
mb_ok+mb_iconquestion);
shellexecute(0, 'open', pchar(key), '', '', sw_shownormal);
end;
end;
Начнём его Разбор с переменной index, где храниться случайное число в промежутке от 0 до keys.count, с его помощью мы будем получать полный путь к любому из множества доступных нам ключей. Потом в открытом ключе читаем параметр uninstallstring и записываем результат в key. Теперь там должен быть путь к деинсталятору, осталось только запустить его, но если какой-то нерадивый программист не указал этот параметр то он будет равен пустой строке и поэтому необходимо переменную key, что мы и сделали.
Меняем заголовки стандартных программ windows.
Подобную шутку обычно реализуют с помощью операций с дескриптором окна, однако можно это сделать из реестра. В интернете мне ни разу не попадался на глаза второй вариант, возможно из-за его ограниченной функциональности. Дело в том, что так можно поменять заголовок только у некоторых стандартных программ windows.
Рассмотрим пример со всеми известной программой windows media player. Для этого надо открыть ключ hkey_current_usersoftwarepoliciesmicrosoft и создать в нём дочерний ключ windowsmediaplayer, после чего в нём создать текстовый параметр titlebar и в него записать всё что вам хочется. Для примера, я внёс туда адрес своего сайта и запустив программу заголовок проигрывателя был следующий: windows media player provided by noil.pri.ee".
Хоть это и не трудно, но реализацию всего вышесказанного всё-таки приведу.
Листинг 6. Меняем заголовки стандартных программ windows.
procedure tform1.changewmpcaptionclick(sender: tobject);
var
reg: tregistry;
begin
reg:=treginifile.create();
reg.rootkey:=hkey_current_user;
reg.openkey('softwarepoliciesmicrosoftwindowsmediaplayer', true);
reg.writestring('titlebar', wmpcaption.text);
reg.free;
end;
Шутки с мышкой.
Неуправляемая мышь.
Любимое занять практически каждого современного пользователя компьютера водить по экрану указатель мыши,щелкав там и тут. Но что он будет делать если мышь сама будет прыгать по экрану, при этом меняя вид своего указателя. Вот сейчас мы научимся это делать всего в три строчки кода.
Листинг 7. Неуправляемая мышь.
procedure tform1.timer2timer(sender: tobject);
const
cursors: array[0..15] of integer=(ocr_normal, ocr_ibeam, ocr_wait, ocr_cross,
ocr_up, ocr_size, ocr_icon,ocr_sizenwse, ocr_sizenesw,
ocr_sizewe, ocr_sizens, ocr_sizeall, ocr_icocur, ocr_no,
ocr_hand, ocr_appstarting);
begin
randomize;
setsystemcursor(getcursor,cursors[random(high(cursors)+1)]);
setcursorpos(random(screen.width), random(screen.height));
end;
В самом начале объявлен массив из указателей на все системные курсоры windows. Сам код написан для события ontimer таймера и поэтому будет выполняться периодически. Всю смысловую нагрузку несут две простых функции: setsystemcursor меняет один курсор на другой. Второй курсор мы случайно выбираем из ранее созданного массива, a setcursorpos определяет новой положений курсора.
Падающая мышь.
Мне всегда больше нравилось найти какую-либо зависимость и заставить указатель не просто двигаться хаотично, а вычерчивать" на экране красивые" линии. Вот сейчас хочу показать, как можно создать эффект того что мышь падает с высоты экрана с ускорением. В самом примере ничего нового нет, просто хочется показать как написать более интересную шутку, чем беспорядочное прыгание мышки по экрану.
Листинг 8. Падающая мышь.
procedure tform1.downmouseclick(sender: tobject);
var
mpos: tpoint;
index: double;
h: hwnd;
begin
b:=true;
h:=createevent(nil, true, false, 'ut');
index:=1;
while b do begin
getcursorpos(mpos);
if mpos.y>=screen.height-20 then begin
waitforsingleobject(h, 5000);
index:=1;
getcursorpos(mpos);
end;
index:=index+index/30;
mpos.y:=mpos.y+round(index);
setcursorpos(mpos.x, mpos.y);
application.processmessages;
waitforsingleobject(h, 10);
end;
end;
Логическая переменная b объявлена глобальной и используется для того, чтобы остановить выполнение кода в нужный момент, присвоив ей значение false.
В архиве, где представлен исходный код программы, в которой собраны все описанные в статье примеры есть вариант подобной шутки, только там мышь не просто падает вниз а прилипает к стенкам экрана, притом чем дальше указатель находиться от центра тем больше его скорость.
Шутки с монитором.
Пишем прямо на мониторе.
Есть два способа нарисовать или написать на мониторе, первый это использовать функции winapi или связать указатель на холст" монитор с объектом tcanvas. И то и другое довольно просто. Рассмотрим сейчас поподробней второй способ.
Листинг 9. Пишем прямо на мониторе.
procedure tform1.button1click(sender: tobject);
var
scr: tcanvas;
begin
scr:=tcanvas.create;
with scr do begin
handle:=getdc(0);
brush.color:=clblue;
font.color:=clred;
font.size:=16;
textout(round(screen.width/2)-round(textwidth(dplcaption.text)/2),
round(screen.height/2)-round(textheight(dplcaption.text)/2),
dplcaption.text);
free;
end;
end;
Самое интересное в этой процедуре - это функция getdc, которая может вернуть контент рисования любого окна. Если мы передадим в неё 0, то получим результатом как раз и будет контент монитора. Теперь остаются присвоить полученное значение свойству handle у созданного объекта типа tcanvas. Любой примитив нарисованный на неё будет мгновенно отображаться на мониторе поверх всех окон.
В приведённом примере, по середине экрана выводиться надпись из компонента типа tedit, расположенного на форме. У меня он носит название dplcaption.
Для того что бы лучше понять и закрепить предложенный материал вы можете рассмотреть ещё один пример по работе с экраном; он выводит на экран большой (800*800 пикселов) дорожный знак stop.
Заключение.
Мы рассмотрели несколько возможностей того как можно весело подшутит над кем-нибудь, но надеюсь вы узнали ещё и что-то новое по работе с операционной системой windows. Возможно у вас созрели свои варианты шуток, но вы не точно не представляете как их реализовать, вы можете оставить сообщение на подумаем вместе. При желании вы сможете увидеть реализацию ваших идей на странице рассылки.