zaparca
10.03.2011, 21:11
Здесь находится руководство по созданию своей программы выложеной в теме [Помогите!] Эмулятор нажатий клавиш!
***
type
TName = class(TThread) // TName - название потока лучше написать своё
private
{ Private declarations }
protected
procedure DoWork;
procedure Execute; override;
end;
...
var
Name: TName;
...
procedure TForm1.Button1Click(Sender: TObject); // события нашей кнопки
begin
if Button1.Caption = 'Stop' then // если кнопка называлась 'Stop'
begin
Name.Terminate; // отключаем поток
Button1.Caption := 'Start'; // называем кнопку 'Start'
Exit; // выход из процедуры
end;
Name:= TName.Create(False); // создаем поток
Name.Priority := tpLower; // устанавливаем приоритет в данном случае низкий
Button1.Caption := 'Stop'; // называем кнопку 'Stop'
end;
...
procedure TName.Execute;
begin
while not Terminated do
Synchronize(DoWork);
end;
...
procedure TName.DoWork;
begin
// тут пишем код который будет работать в потоке
end;
***
*** // копируем как есть
procedure SimulateKeyDown(Key: byte);
begin
keybd_event(Key, 0, 0, 0);
end;
procedure SimulateKeyUp(Key: byte);
begin
keybd_event(Key, 0, KEYEVENTF_KEYUP, 0);
end;
procedure SimulateKeystroke(Key: byte; extra: DWORD);
begin
keybd_event(Key, extra, 0, 0);
keybd_event(Key, extra, KEYEVENTF_KEYUP, 0);
end;
procedure SendKeys(s: string);
var
i: integer;
flag: bool;
w: word;
begin
{Get the state of the caps lock key}
flag := not GetKeyState(VK_CAPITAL) and 1 = 0;
{If the caps lock key is on then turn it off}
if flag then
SimulateKeystroke(VK_CAPITAL, 0);
for i := 1 to Length(s) do
begin
w := VkKeyScan(s[i]);
{If there is not an error in the key translation}
if ((HiByte(w) <> $FF) and (LoByte(w) <> $FF)) then
begin
{If the key requires the shift key down - hold it down}
if HiByte(w) and 1 = 1 then
SimulateKeyDown(VK_SHIFT);
{Send the VK_KEY}
SimulateKeystroke(LoByte(w), 0);
{If the key required the shift key down - release it}
if HiByte(w) and 1 = 1 then
SimulateKeyUp(VK_SHIFT);
end;
end;
{if the caps lock key was on at start, turn it back on}
if flag then
SimulateKeystroke(VK_CAPITAL, 0);
end;
***// так как сам еще не разбирался
***
procedure TName.DoWork; // собственно поток
var
K: Integer; // время паузы в секундах
Key: string; // клавиша
pa1: ttime; // системное время
begin
Key := (Form1.Edit1.Text); // получаем клавишу из Edit1
K := StrToInt(Form1.Edit2.Text); // получаем секунды из Edit2
if Form1.CheckBox1.Checked = true then // проверяем CheckBox1 на галку )
begin
SendKeys(Key); // отправляем клавишу из Edit1 в SendKeys
Application.ProcessMessages;
end;
pa1 := (K * 1.1574074074074074074074074074074E-5) + time; //вычисляем время задержки точно
repeat // если не равно
application.processmessages;
sleep(10); // спим )
until time >= pa1; // проверяем
Application.ProcessMessages;
end;
***
[Ссылки могут видеть только зарегистрированные и активированные пользователи] ([Ссылки могут видеть только зарегистрированные и активированные пользователи])
В: Почему картинка?
О: Посмотрите в Яндексе ) самый первый ответ! ([Ссылки могут видеть только зарегистрированные и активированные пользователи] %D0%BC%D1%83+%D0%BA%D0%B0%D1%80%D1%82%D0%B8%D0%BD% D0%BA%D0%B0%3F+%D0%9E%3A&clid=46510&lr=172)
***
type
TName = class(TThread) // TName - название потока лучше написать своё
private
{ Private declarations }
protected
procedure DoWork;
procedure Execute; override;
end;
...
var
Name: TName;
...
procedure TForm1.Button1Click(Sender: TObject); // события нашей кнопки
begin
if Button1.Caption = 'Stop' then // если кнопка называлась 'Stop'
begin
Name.Terminate; // отключаем поток
Button1.Caption := 'Start'; // называем кнопку 'Start'
Exit; // выход из процедуры
end;
Name:= TName.Create(False); // создаем поток
Name.Priority := tpLower; // устанавливаем приоритет в данном случае низкий
Button1.Caption := 'Stop'; // называем кнопку 'Stop'
end;
...
procedure TName.Execute;
begin
while not Terminated do
Synchronize(DoWork);
end;
...
procedure TName.DoWork;
begin
// тут пишем код который будет работать в потоке
end;
***
*** // копируем как есть
procedure SimulateKeyDown(Key: byte);
begin
keybd_event(Key, 0, 0, 0);
end;
procedure SimulateKeyUp(Key: byte);
begin
keybd_event(Key, 0, KEYEVENTF_KEYUP, 0);
end;
procedure SimulateKeystroke(Key: byte; extra: DWORD);
begin
keybd_event(Key, extra, 0, 0);
keybd_event(Key, extra, KEYEVENTF_KEYUP, 0);
end;
procedure SendKeys(s: string);
var
i: integer;
flag: bool;
w: word;
begin
{Get the state of the caps lock key}
flag := not GetKeyState(VK_CAPITAL) and 1 = 0;
{If the caps lock key is on then turn it off}
if flag then
SimulateKeystroke(VK_CAPITAL, 0);
for i := 1 to Length(s) do
begin
w := VkKeyScan(s[i]);
{If there is not an error in the key translation}
if ((HiByte(w) <> $FF) and (LoByte(w) <> $FF)) then
begin
{If the key requires the shift key down - hold it down}
if HiByte(w) and 1 = 1 then
SimulateKeyDown(VK_SHIFT);
{Send the VK_KEY}
SimulateKeystroke(LoByte(w), 0);
{If the key required the shift key down - release it}
if HiByte(w) and 1 = 1 then
SimulateKeyUp(VK_SHIFT);
end;
end;
{if the caps lock key was on at start, turn it back on}
if flag then
SimulateKeystroke(VK_CAPITAL, 0);
end;
***// так как сам еще не разбирался
***
procedure TName.DoWork; // собственно поток
var
K: Integer; // время паузы в секундах
Key: string; // клавиша
pa1: ttime; // системное время
begin
Key := (Form1.Edit1.Text); // получаем клавишу из Edit1
K := StrToInt(Form1.Edit2.Text); // получаем секунды из Edit2
if Form1.CheckBox1.Checked = true then // проверяем CheckBox1 на галку )
begin
SendKeys(Key); // отправляем клавишу из Edit1 в SendKeys
Application.ProcessMessages;
end;
pa1 := (K * 1.1574074074074074074074074074074E-5) + time; //вычисляем время задержки точно
repeat // если не равно
application.processmessages;
sleep(10); // спим )
until time >= pa1; // проверяем
Application.ProcessMessages;
end;
***
[Ссылки могут видеть только зарегистрированные и активированные пользователи] ([Ссылки могут видеть только зарегистрированные и активированные пользователи])
В: Почему картинка?
О: Посмотрите в Яндексе ) самый первый ответ! ([Ссылки могут видеть только зарегистрированные и активированные пользователи] %D0%BC%D1%83+%D0%BA%D0%B0%D1%80%D1%82%D0%B8%D0%BD% D0%BA%D0%B0%3F+%D0%9E%3A&clid=46510&lr=172)