О десктопах и семафорах
 |
Наши проекты:
Журнал · Discuz!ML · Wiki · DRKB · Помощь проекту |
|
| ПРАВИЛА | FAQ | Помощь | Поиск | Участники | Календарь | Избранное | RSS |
| [3.136.18.48] |
|
|
О десктопах и семафорах
|
Сообщ.
#1
,
|
  |
Данный пример показывает, как работать с десктопами и семафорами.
Что будем делать? Мы напишем программульку, которая будет создавать отдельный "рабочий стол" в системе, и переключать пользователя в него. В этом рабочем столе мы будем запускать эмулятор VMWare(в примере он заменем блокнотом, т.к. VMWare есть не у всех). Эмулятор будет выполняться совершенно обослебоно от всего, в новом рабочем столе нельзя вызвать деспетчер задач(т.е. вызвать можно, а вот увидеть - нет). Кроме того, единственное рабочее служебное сочетание клавиш - Win+L. С помощью него можно сделать logout(и то не так то просто...), однако разблокировать windows все равно нельзя... После того как VMWare(или блокнот, или любая другая прога) закроется, появится окошко, с предложением ввести пароль. Замечу, что окошко можно закрыть, нажав на крестик, однако это будет весма не благоразумно, т.к. программа "разблокировки" то завершиться, а вот обратного переключения не произойдет, и пред вами предстанет голый десктоп  Для разблокировки надо ввести пароль, AAA.Только после этого произойдет "взаправдашняя" разблокировка.Как? Очень просто Для начала рекомендую таки почитать разделы MSDN, касайющиеся десктоп и светофоров. Для удобства приведу тут код двух программ, для блокировки и соответственно разблокировки.Блокировщик:   Sub Main() Dim hSemaphore As Long, hDesktop As Long Dim hOldDesktop As Long 'Создаем семафор hSemaphore = CreateSemaphore(0, 0, 10, SEMAPHORE_NAME) 'Узнаем, какой сейчас десктоп hOldDesktop = GetThreadDesktop(GetCurrentThreadId) 'Создаем новый десктоп hDesktop = CreateDesktopA(DESKTOP_NAME, 0, 0, 0, GENERIC_ALL, 0) If hDesktop <> 0 Then 'Переключаемся в новый десктоп SwitchDesktop hDesktop Dim sti As STARTUPINFO, spi As PROCESS_INFORMATION sti.cb = Len(sti) sti.lpDesktop = DESKTOP_NAME 'Запускаем VMWare или чтото еще... CreateProcess WMWARE_EXECUTABLE_NAME, "", 0&, 0&, 0, NORMAL_PRIORITY_CLASS, ByVal 0&, CurDir, sti, spi 'Ждем его закрытия WaitForSingleObject spi.hProcess, -1 'Запускаем "анлокер". Если он вдруг не запустится, пеняйте на себя :) CreateProcess App.Path & "\WaitForShutdown.exe", "", 0&, 0&, 0, NORMAL_PRIORITY_CLASS, ByVal 0&, CurDir, sti, spi 'Ждем, когда загорится семафор Call WaitForSingleObject(hSemaphore, -1) 'Сворачиваем лавочку: закрываем дескрипторы и переключаемся в обычный десктоп CloseHandle hSemaphore SwitchDesktop hOldDesktop CloseDesktop hDesktop Else MsgBox "Can't create desktop" & vbCrLf & Err.LastDllError End If CloseDesktop hOldDesktop End Sub Разблокировщик: Dim hSemaphore As Long Private Sub cmdOK_Click() If txtPwd.Text = "AAA" Then 'Если пароль правильный 'Уменьшим семафор ReleaseSemaphore hSemaphore, 2, 0 CloseHandle hSemaphore 'И выходим End Else MsgBox "You type wrong password!", vbExclamation End If End Sub Private Sub Form_Load() 'Пытаемся открыть семафор hSemaphore = OpenSemaphore(GENERIC_ALL, 0, SEMAPHORE_NAME) If hSemaphore = 0 Then MsgBox "Can't open semaphore", vbCritical End End If End Sub |
0 пользователей читают эту тему (0 гостей и 0 скрытых пользователей)
0 пользователей:
[ Script execution time: 0,0209 ] [ 16 queries used ] [ Generated: 28.04.24, 09:24 GMT ]