Отправляет email-рассылки с помощью сервиса Sendsay

RFpro.ru: Программирование на Delphi и Lazarus

Подписаться Бесплатная «Золотая» новостная рассылка . Подписчиков 3.312 RSS
←   Август 2010   →
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31


За последние 60 дней ни разу не выходила


Сайт рассылки: http://rusfaq.ru/
Открыта: 14-03-2002

Автор
Калашников О.А.

Статистика

3.312 подписчиков
0 за неделю
←   Все выпуски   →

RFpro.ru: Программирование на Delphi и Lazarus


Хостинг портала RFpro.ru:
Московский хостер
Профессиональный ХОСТИНГ на базе Linux x64 и Windows x64

РАССЫЛКИ ПОРТАЛА RFPRO.RU

Чемпионы рейтинга экспертов в этой рассылке

Boriss
Статус: Академик
Рейтинг: 2460
∙ повысить рейтинг » 		star9491
Статус: Профессионал
Рейтинг: 2271
∙ повысить рейтинг » 		Евгений/Genia007/
Статус: Профессионал
Рейтинг: 1078
∙ повысить рейтинг »

/ КОМПЬЮТЕРЫ И ПО / Программирование / Delphi и Lazarus

Номер выпуска:1547
Дата выхода:12.08.2010, 20:00
Администратор рассылки:Калашников О.А., Руководитель
Подписчиков / экспертов:291 / 188
Вопросов / ответов:1 / 1

Вопрос № 179678: Здравствуйте Уважаемые эксперты. Подскажите пожалуйста, есть ли способ зная класс запущенной программы послать ей нажатие некоторых клавиш. Например, чтобы в ней нажалась клавиша "T" или же "ENTER"... ...

Вопрос № 179678:

Здравствуйте Уважаемые эксперты. Подскажите пожалуйста, есть ли способ зная класс запущенной программы послать ей нажатие некоторых клавиш.
Например, чтобы в ней нажалась клавиша "T" или же "ENTER"...

Отправлен: 07.08.2010, 18:31
Вопрос задал: Dimon4ik, 5-й класс
Всего ответов: 1
Страница вопроса »

Отвечает Евгений/Genia007/, Профессионал :
Здравствуйте, Dimon4ik.
Как вариант могу предложить компонент Sendkeys, который посылает нажатие клавиш в другие приложения. Автор: Gert v.d. Venis:
Код:
unit SendKeys;

interface

uses
  Windows, Messages,
SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

type
  TSendKeys = class(TComponent)
  private
    fhandle: HWND;
    L: Longint;
    fchild: boolean;
    fChildText: string;
    procedure SetIsChildWindow(const Value: boolean);
    procedure SetChildText(const Value: string);
    procedure SetWindowHandle(const Value: HWND);
  protected

  public

  published
    procedure GetWindowHandle(Text: string);
    p
 rocedure SendKeys(buffer: string);
    property WindowHandle: HWND read fhandle write SetWindowHandle;
    property IsChildWindow: boolean read fchild write SetIsChildWindow;
    property ChildWindowText: string read fChildText write SetChildText;
  end;

procedure Register;

implementation

var
  temps: string; {й utilizado para ser acessivel pelas funcs q sao
  utilizadas como callbacks}
  HTemp: Hwnd;
  ChildText: string;
  ChildWindow: boolean;

procedure
Register;
begin
  RegisterComponents('Standard', [TSendKeys]);
end;

{ TSendKeys }

function PRVGetChildHandle(H: HWND; L: Integer): LongBool;
var
  p: pchar;
  I: integer;
  s: string;
begin
  I := length(ChildText) + 2;
  GetMem(p, i + 1);
  SendMessage(H, WM_GetText, i, integer(p));
  s := strpcopy(p, s);
  if pos(ChildText, s) <> 0 then
  begin
    HTemp := H;
    Result := False
  end
 
  else
    Result := True;
  FreeMem(p);
end;

function PRVSendKeys(H: HWND; L: Integer): LongBool; stdcall;
var
  s: string;
  i: integer;
begin
  i := length(temps);
  if i <> 0 then
  begin
    SetLength(s, i + 2);
    GetWindowText(H, pchar(s), i + 2);
    if Pos(temps, string(s)) <> 0 then
    begin
      Result := false;
      if ChildWindow then
        EnumChildWindows(H, @PRVGetChildHandle, L)
      else
        HTemp := H;

   end
    else
      Result := True;
  end
  else
    Result := False;
end;

procedure TSendKeys.GetWindowHandle(Text: string);
begin
  temps := Text;
  ChildText := fChildText;
  ChildWindow := fChild;
  EnumWindows(@PRVSendKeys, L);
  fHandle := HTemp;
end;

procedure TSendKeys.SendKeys(buffer: string);
var
  i: integer;
  w: word;
  D: DWORD;
  P: ^DWORD;
begin
  P := @D;
  SystemParametersIn
 fo(//get flashing timeout on win98
    SPI_GETFOREGROUNDLOCKTIMEOUT,
    0,
    P,
    0);
  SetForeGroundWindow(fHandle);
  for i := 1 to length(buffer) do
  begin
    w := VkKeyScan(buffer[i]);
    keybd_event(w, 0, 0, 0);
    keybd_event(w, 0, KEYEVENTF_KEYUP, 0);
  end;
  SystemParametersInfo(//set flashing TimeOut=0
    SPI_SETFOREGROUNDLOCKTIMEOUT,
    0,
    nil,
    0);
  SetForegroundWindow(TWinControl(TComponent(Self).Owner).Handle);
  //->typecast
working...
  SystemParametersInfo(//set flashing TimeOut=previous value
    SPI_SETFOREGROUNDLOCKTIMEOUT,
    D,
    nil,
    0);
end;

procedure TSendKeys.SetChildText(const Value: string);
begin
  fChildText := Value;
end;

procedure TSendKeys.SetIsChildWindow(const Value: boolean);
begin
  fchild := Value;
end;

procedure TSendKeys.SetWindowHandle(const Value: HWND);
begin
  fHandle := WindowHandle;

 end;

end.

Описание:

Данный компонент получает хэндл(handle) любого запущенного окна и даёт возможность отправить по указанному хэндлу любые комбинации нажатия клавиш.

Совместимость: Все версии Delphi

Собственно сам исходничек:

После того, как проинсталируете этот компонент, создайте новое приложение и поместите на форму кнопку и сам компонент SendKeys. Добавьте следующий код в обработчик события OnClick кнопки:
Код:
procedure TForm1.Button1Click(Sender: TObject);
begin
  // Запускаем Notepad, и ему мы будем посылать нажатия клавиш
  WinExec('NotePad.exe', SW_SHOW);
  // В параметре процедуры GetWindowHandle помещаем
  // текст заголовка окна Notepad'а.
  SendKeys1.GetWindowHandle('Untitled - Notepad');
  // Если хэндл окна получен усп
 ешно, то отправляем ему текст
  if SendKeys1.WindowHandle <> 0 then
    SendKeys1.SendKeys('This is a test');
  // Так же можно отправить код любой кнопки типа
  // RETURN, используя следующий код:
  // SendKeys1.SendKeys(Chr(13));
end;

Взято с сайта Delphi World. Архив с компонентом (сделан на deplhi7) и примером.

-----
Помогли тебе, помоги и ты.

Ответ отправил: Евгений/Genia007/, Профессионал
Ответ отправлен: 12.08.2010, 11:23
Номер ответа: 262791

Оценка ответа: 5
Комментарий к оценке:
Большое спасибо за четкий, разверутый и очень полезный ответ.

Вам помог ответ? Пожалуйста, поблагодарите эксперта за это!
Как сказать этому эксперту "спасибо"?
  • Отправить SMS #thank 262791 на номер 1151 (Россия) | Еще номера »
  • Отправить WebMoney:

    • Оценить выпуск »
    Нам очень важно Ваше мнение об этом выпуске рассылки!

    Задать вопрос экспертам этой рассылки »

    Скажите "спасибо" эксперту, который помог Вам!

    Отправьте СМС-сообщение с тестом #thank НОМЕР_ОТВЕТА
    на короткий номер 1151 (Россия)
    Номер ответа и конкретный текст СМС указан внизу каждого ответа.

    Полный список номеров »

    * Стоимость одного СМС-сообщения от 7.15 руб. и зависит от оператора сотовой связи. (полный список тарифов)
    ** При ошибочном вводе номера ответа или текста #thank услуга считается оказанной, денежные средства не возвращаются.
    *** Сумма выплаты эксперту-автору ответа расчитывается из суммы перечислений на портал от биллинговой компании.

    © 2001-2010, Портал RFpro.ru, Россия
    Авторское право: ООО "Мастер-Эксперт Про"
    Автор: Калашников О.А. | Программирование: Гладенюк А.Г.
    Хостинг: Компания "Московский хостер"
    Версия системы: 2010.6.16 от 26.05.2010
    В избранное