Проблемы при работе с keyboard&mouse через API

Программирование на Visual Basic, главный форум. Обсуждение тем программирования на VB 1—6.
Даже если вы плохо разбираетесь в VB и программировании вообще — тут вам помогут. В разумных пределах, конечно.
Правила форума
Темы, в которых будет сначала написано «что нужно сделать», а затем просьба «помогите», будут закрыты.
Читайте требования к создаваемым темам.
DSO_Neo
Начинающий
Начинающий
 
Сообщения: 1
Зарегистрирован: 16.04.2003 (Ср) 10:59

Проблемы при работе с keyboard&mouse через API

Сообщение DSO_Neo » 16.04.2003 (Ср) 11:45

==================================
* MouseScroller 1.0 - информация к размышлению *
==================================

About:
MouseScroller - банальная программа содержащая
только одну главную подпрограмму. Она перемещает
указатель с одной границы на другую, создавая эф-
фект безграничности. В программе предусмотрено
автоматическое занесение в автозапуск и клавиша от-
ключения/включения перемещения указателя (Scroll
Lock на клаве). Основана она на применении функций
API для работы с консолью, конкретнее - клавой и
мышкой. Функциональна и работоспособна, если бы
не одно громадное но...

На этой программе можно проверять крепость нер-
вов программиста или beta-тестера! Таких глубоко-
интеллектуальных глюков я не видел со времён Win95!

А именно: При запуске с виртуальной машиной VB
(то есть из среды разработки - F5) программа работает
БЕЗ проблем, что похвально для Microsoft... Но!!! Сто-
ит запустить прогу, откомпилированную самыми раз-
ными способами, как она начинает глючить (что НЕ
похвально для Microsoft), а именно:

Bug:
1. Программа использует функцию API для проверки
состояния клавиши Scroll Lock, но во время работы
не реагирует на смену состояния. Использует сос-
тояние Scroll Lock'а на момент запуска.
2. При смене разрешения экрана программа продол-
жает использовать координаты границ окна при
старом разрешении.

Fix:
В программе использованы 3 переменные, все они
получают значение в теле бесконечного цикла при
каждом повторе, и тут же проверяются. Подробный
анализ позволил установить, что ошибки программы
вызванны тем, что эти переменные не изменяют
значение (причина неизвестна), но программа не гене-
рирует ошибку, значит... а дальше я не знаю как назвать
это хамство со стороны компьютера: "Ты, чувак, напи-
сал всё правильно, но исполнять я это всё равно не буду"

Исходник (Всего один модуль):

=======================================
Option Explicit
' Возвращает текущие координаты
Private Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long
' Устанавливает указатель мыши в указанную точку
Private Declare Function GetCursorPos Lib "user32" (lpPoint As Point) As Long
' Определяет состояние клавиатуры (в массиве из 256 элементов - клавишь
' сохраняется состояние для каждого элемента. 0 - не нажата, 1 - нажата.)
Private Declare Function GetKeyboardState Lib "user32" (pbKeyState As tkbArray) As Long
' Получает манипулятор (Handle) ключа реестра для функ. RegSetValueEx
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
' Закрывает открытый предыдущей функцией ключь
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
' Присваивает ключу значение по известному манипулятору.
Private 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

' Этот тип данных призван содержать координаты точки
Type Point
X As Long
Y As Long
End Type

' Этот тип содержит состояние клавишь
Type tkbArray
kbKey(256) As Byte
End Type

Dim CurrentPos As Point
Dim SW As Single, SH As Single
Dim KbArray As tkbArray

Private Sub Main()
App.TaskVisible = False

If App.PrevInstance Then End

AddMeToAutorun ' Функция добавления в автозапуск

DoEvents
Do

Call GetKeyboardState(KbArray)

If Not KbArray.kbKey(145) = 1 Then
SW = Screen.Width / Screen.TwipsPerPixelX
SH = Screen.Height / Screen.TwipsPerPixelY

Call GetCursorPos(CurrentPos)

If CurrentPos.X >= SW - 1 Then Call SetCursorPos(1, CurrentPos.Y)
If CurrentPos.X = 0 Then Call SetCursorPos(SW - 2, CurrentPos.Y)
If CurrentPos.Y >= SH - 1 Then Call SetCursorPos(CurrentPos.X, 1)
If CurrentPos.Y = 0 Then Call SetCursorPos(CurrentPos.X, SH - 2)
End If
DoEvents
Loop
End Sub

Private Sub AddMeToAutorun()
Dim Result As Long
Dim Retval As Long
Dim sPath As String

If Right(App.Path, 1) = "\" Then sPath = App.Path & App.EXEName & ".exe" Else sPath = App.Path & "\" & App.EXEName & ".exe"

Retval = RegOpenKeyEx(&H80000001, "Software\Microsoft\Windows\CurrentVersion\Run", 0, &H3F, Result)

Call RegSetValueEx(Result, App.Title, 0, 1, ByVal sPath, Len(sPath))
Call RegCloseKey(Result)
End Sub
======================================
Help Me!
</Neo>

FaKk2
El rebelde gur&#250;
El rebelde gur&#250;
Аватара пользователя
 
Сообщения: 2031
Зарегистрирован: 09.03.2003 (Вс) 22:10
Откуда: Los Angeles

Сообщение FaKk2 » 16.04.2003 (Ср) 15:29

Не знаю в чем прикол, но твой код нормально работает у меня и в скомпилированом виде.....
Для получения ответа надо продемонстрировать качества, позволяющие стать компетентным — внимательность, вдумчивость, наблюдательность, желание активно участвовать в выработке решения.


Вернуться в Visual Basic 1–6

Кто сейчас на конференции

Сейчас этот форум просматривают: Google-бот, Yandex-бот и гости: 54

    TopList