|
Вопрос # 5 407/ вопрос открыт / |
|
Приветствую, уважаемые эксперты!
Пробовал имитировать нажатие клавиш, в блокноте всё печатается, в нужном приложение, нет((
Гуглил, нашёл что это возможно из-за того что приложение использует directX
Подскажите пожалуйста есть ли альтернатива keybd_event? Если есть, то как это осуществить чтоб работала во всех приложениях(программах)
keybd_event($09, 0, 0, 0); //Нажатие TAB.
keybd_event($09, 0, KEYEVENTF_KEYUP, 0); //Отпускание TAB.
//Пауза.
Application.ProcessMessages;
Sleep(StrToInt(Edit3.Text));
//Ввод '1'
keybd_event($31, 0, 0, 0); //Нажатие '1'.
keybd_event($31, 0, KEYEVENTF_KEYUP, 0); //Отпускание '1'.
//Пауза
Application.ProcessMessages;
Sleep(StrToInt(Edit4.Text));
//Ввод '2'
keybd_event($32, 0, 0, 0); //Нажатие '2.
keybd_event($32, 0, KEYEVENTF_KEYUP, 0); //Отпускание '2'.
//Пауза.
Application.ProcessMessages;
Sleep(StrToInt(Edit5.Text));
//Ввод '3'
keybd_event($33, 0, 0, 0); //Нажатие '3'.
keybd_event($33, 0, KEYEVENTF_KEYUP, 0); //Отпускание '3'.
//Пауза.
Application.ProcessMessages;
Sleep(StrToInt(Edit6.Text));
 |
Вопрос задал: nirlog (статус: Посетитель)
Вопрос отправлен: 14 июня 2011, 06:55
Состояние вопроса: открыт, ответов: 1.
|
Ответ #1. Отвечает эксперт: Gooddy
Здравствуйте, nirlog!
Можно попробовать отсылать сообщения в определённое окно. Тогда можно будет посылать клавиши даже в окно не имеющее фокуса!
Сам года два назад делал такое для WoW, но исходники утеряны.
Приложение: Переключить в обычный режим- var
- wnd: HWND;
- i: Integer;
- s: string;
- begin
-
- if wnd <> 0 then
- begin
- s := 'Hello';
- for i := 1 to Length(s) do
- SendMessage(wnd, WM_CHAR, Word(s[i]), 0);
- end;
- end;
 |
Ответ отправил: Gooddy (статус: 3-ий класс)
Время отправки: 14 июня 2011, 17:43
Оценка за ответ: 3
Комментарий к оценке: не заработало, программа запускается но ничего не происходит. Вопрос открыт!
|
Мини-форум вопроса
Всего сообщений: 11; последнее сообщение — 17 июня 2011, 15:16; участников в обсуждении: 4.
|
min@y™ (статус: Доктор наук), 14 июня 2011, 08:29 [#1]:
А чо за приложение-то?
Делаю лабы и курсачи по Delphi и Turbo Pascal. За ПИВО! Пишите в личку, а лучше в аську. А ещё лучше - звоните в скайп!
|
|
Вадим К (статус: Академик), 14 июня 2011, 09:57 [#2]:
Вполне может быть, что приложение "сопротивляется" эмуляции нажатий клавиш. Особенно, если это какой-нибудь LA2 или CS.
Галочка "подтверждения прочтения" - вселенское зло.
|
|
|
nirlog (статус: Посетитель), 14 июня 2011, 11:32 [#3]:
приложение на подобии LA2, из того что может там мешать это только GG(GameGuard)
вожможно ли это осуществить через SimulateKeyDown(), SimulateKeyUp() и SimulateKeystroke()?
|
|
|
Вадим К (статус: Академик), 14 июня 2011, 11:43 [#4]:
Ну подумайте, зачем там GameGuard? думаете это писали простаки?
Я знаю только один дешевый и хороший способ симулировать набор на клавиатуре - это обычный человек.
Вывод, симулировать, думаю можно, но это достаточно сложная задача. Лучше просто перестать играть в игры или играть по честному.
Галочка "подтверждения прочтения" - вселенское зло.
|
|
|
nirlog (статус: Посетитель), 14 июня 2011, 12:51 [#5]:
т.е такая задача вам не посилам?
Есть ещё два варианта DirectInput и SimulateKeystroke(), но не смог найти ничего путного про то как это использовать, может хотя бы подскажите где можно найти инфу про них
экранная клавиатура там работает, значит это реально сделать
|
|
|
Вадим К (статус: Академик), 14 июня 2011, 13:25 [#6]:
Думаю по силам, вот только винду вначале придется поставить Потом делфи и неведомую игрушку.
Хотя есть экранная клавиатура работает, то вполне и приведенный выше пример должен работать, просто нужно знать, кому отправлять данные. А если слать на бум, то конечно, ничего работать не будет.
Галочка "подтверждения прочтения" - вселенское зло.
|
|
|
Gooddy (статус: 3-ий класс), 14 июня 2011, 17:51 [#7]:
Извиняюсь, не тот код послал!
procedure sendKeys( SomeText: string );
var
TI: TInput;
KI: TKeybdInput;
I: Integer;
begin
TI.Itype := INPUT_KEYBOARD;
for I := 1 to Length(SomeText) do
begin
KI.wVk := Ord(UpCase(SomeText[I]));
KI.dwFlags := 0;
TI.ki := KI;
SendInput(1, TI, SizeOf(TI));
KI.dwFlags := KEYEVENTF_KEYUP;
TI.ki := KI;
SendInput(1, TI, SizeOf(TI));
sleep(10);
end;
end;
Но посылает только в активное окно.
Чисти код! Чисти код! Чисти код!
|
|
|
nirlog (статус: Посетитель), 15 июня 2011, 11:22 [#8]:
киньте ссылку на модуль sendkeys
|
|
|
nirlog (статус: Посетитель), 16 июня 2011, 19:26 [#9]:
Мучался, мучался с sendkeys, вроде запускается, но ничего не делает(((
вышло следущее:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, SendKey;
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
TI: TInput;
KI: TKeybdInput;
I: Integer;
SomeText: string;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
TI.Itype := INPUT_KEYBOARD;
for I := 1 to Length(SomeText) do
begin
KI.wVk := Ord(UpCase(SomeText[I]));
KI.dwFlags := 0;
TI.ki := KI;
SendInput(1, TI, SizeOf(TI));
KI.dwFlags := KEYEVENTF_KEYUP;
TI.ki := KI;
SendInput(1, TI, SizeOf(TI));
sleep(10);
end;
end;
end.
поправь если что-то не так
изначальная версия у меня даже запускаться не хотела
procedure sendKeys( SomeText: string );
var
TI: TInput;
KI: TKeybdInput;
I: Integer;
begin
TI.Itype := INPUT_KEYBOARD;
for I := 1 to Length(SomeText) do
begin
KI.wVk := Ord(UpCase(SomeText[I]));
KI.dwFlags := 0;
TI.ki := KI;
SendInput(1, TI, SizeOf(TI));
KI.dwFlags := KEYEVENTF_KEYUP;
TI.ki := KI;
SendInput(1, TI, SizeOf(TI));
sleep(10);
end;
end;
выдавало кучу ошибок постоянно придирался к procedure sendKeys( SomeText: string ); и к for I := 1 to Length(SomeText) do
|
|
|
nirlog (статус: Посетитель), 17 июня 2011, 14:02 [#10]:
выдаёт ошибку
Undeclared identifier: 'SomeText'
в строке
for I := 1 to Length(SomeText) do
|
|
|
nirlog (статус: Посетитель), 17 июня 2011, 15:16 [#11]:
unit Key;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, sndkey32, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var
TI: TInput;
KI: TKeybdInput;
I: Integer;
SomeText: string;
begin
TI.Itype := INPUT_KEYBOARD;
for I := 1 to Length(SomeText) do
begin
KI.wVk := Ord(UpCase(SomeText[I]));
KI.dwFlags := 0;
TI.ki := KI;
SendInput(1, TI, SizeOf(TI));
KI.dwFlags := KEYEVENTF_KEYUP;
TI.ki := KI;
SendInput(1, TI, SizeOf(TI));
sleep(1000);
end;
end;
end.
вот что получилось, толку 0, запускается но ничего не происходит
|
Чтобы оставлять сообщения в мини-форумах, Вы должны авторизироваться на сайте.
|
