Форум программистов
 
Контакты: о проблемах с регистрацией, почтой и по другим вопросам пишите сюда - alarforum@yandex.ru, проверяйте папку спам! Обязательно пройдите активизацию e-mail.

Вернуться   Форум программистов > Delphi > Паскаль, Turbo Pascal, PascalABC.NET
Регистрация

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


Ответ
 
Опции темы
Старый 14.12.2019, 23:23   #1
ProMKQ
Пользователь
 
Регистрация: 10.11.2019
Сообщений: 13
По умолчанию Консоль поверх других программ

Вообщем, я хотел создать консольную програмку которая запускается когда я включаю комп, переключается в фоновый режим и регистрирует нажатия клавиш. Как только я нажимаю (например Tab) она вырубает екран. Ну и тому подобное.
С фоновым режимом, активации при запуске и вырубанием екрана я уже разобрался. Но проблема в том, что если использовать ReadKey, то програма не регестрирует нажатия в фоновом режиме и даже когда свёрнута. С WinAPI и RegisterHotKey разобратся не смог. В принципе я придумал способ как это сделать: минимизировать размеры консоли, но для этого нужно, что бы она оставалась поверх других програм.
Кто то может подсказать, как заставить консоль быть всегда сверху, или что б она регистрирована нажатия клавиш в фоновом режиме?
Язык: Free Pascal, Среда: Lazarus.
ProMKQ вне форума Ответить с цитированием
Старый 15.12.2019, 02:37   #2
Pavia
Лис
Старожил
 
Аватар для Pavia
 
Регистрация: 18.09.2015
Сообщений: 2,050
По умолчанию

А вам зачем консоль нужна? Может Memo хватит?
А так хук на клавиатуру и обрабатывать сообщение.
грамотный hook на клавиатуру
Хорошо поставленный вопрос это уже половина ответа. | Каков вопрос, таков ответ.
У дзен программиста программа делает то что он хотел, а не то что он написал .
Pavia на форуме Ответить с цитированием
Старый 18.12.2019, 10:06   #3
NetSpace
Участник клуба
 
Аватар для NetSpace
 
Регистрация: 03.06.2009
Сообщений: 1,474
По умолчанию

чего-то по ссылке не переходит. проверь, пожалуйста. а то тоже интересно - мучал как-то эту тему....
Программирование - это единственный способ заставить компьютер делать то, что тебе хочется, а не то, что приходится.
NetSpace вне форума Ответить с цитированием
Старый 18.12.2019, 19:05   #4
Alar
Александр
Администратор
 
Аватар для Alar
 
Регистрация: 28.10.2006
Сообщений: 15,303
По умолчанию

Цитата:
Сообщение от NetSpace Посмотреть сообщение
не переходит.
У меня переходит, может сайт был временно недоступен?

Вот скопировал вам код. но там ещё большое обсуждение по ссылке.

Цитата:
Вот вам простой пример работающий без DLL (правда только в WINNT)
Код:
unit kbLog32;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,TFilerSrc, StdCtrls;
const WH_KEYBOARD_LL = 13; crlf = #$0D#$0A;

type
 TKBDLLHOOKSTRUCT = packed record
    vkCode      :DWORD;
    scanCode    :DWORD;
    flags       :DWORD;
    time        :DWORD;
    dwExtraInfo :pointer;
 end;
 PKBDLLHOOKSTRUCT = ^TKBDLLHOOKSTRUCT;

  TKbdFrm = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  KbdFrm: TKbdFrm;
  kHook : cardinal;
  Filer : TFileManager;
implementation
{$R *.dfm}
function GetChar(lparam: integer): string;
var
 data : PKBDLLHOOKSTRUCT;
 keystate: TKeyboardState;
 retcode: Integer;
 l : hkl;
begin
 data := pointer(lparam);
 GetKeyboardState(keystate);
 l :=GetKeyBoardLayout(GetWindowThreadProcessId( GetForegroundWindow ));
 SetLength(Result, 2) ;
 retcode := ToAsciiEx(data.vkCode,data.scanCode,keystate, @Result[1],0,l);
 case retcode of
   0: Result := '';
   1: SetLength(Result, 1) ;
   else Result := '';
 end;
end;
(*==============================================================================================*)
Function sGetLastError:string;
var
 err:dword;
 buf:pchar;
begin
 err:=GetLastError;
 FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM or FORMAT_MESSAGE_ALLOCATE_BUFFER,nil,err,0,@buf,0,nil);
 result:=string(buf);
 LocalFree(cardinal(buf));
end;
(*==============================================================================================*)
function KbdProc(code: integer; wparam: integer; lparam: integer):Integer; stdcall;
begin
 if (code < 0) or (code <> HC_ACTION) then result := 0 else
  begin
   if wParam = wm_keydown then
    begin
     // запись в файл
     Filer.WriteBuf('d:\dia\ownprojects\kLogger\test.txt',PChar(GetChar(lparam)));
     // Filer - что то типа "писателя в файлы"  =)
    end;
   if wParam = wm_syskeydown then
    begin
     // обработай сам если надо
    end;
   Result:=0;
  end;
end;
(*==============================================================================================*)
procedure TKbdFrm.FormCreate(Sender: TObject);
begin
 kHook := SetWindowsHookEx(WH_KEYBOARD_LL,@KbdProc,HInstance,0);
 if kHook <> INVALID_HANDLE_VALUE then
  begin
   Filer := TFileManager.Create;
   Filer.WriteBuf('d:\dia\ownprojects\kLogger\test.txt','Log started'+crlf);
  end ;
end;
(*==============================================================================================*)
procedure TKbdFrm.FormDestroy(Sender: TObject);
begin
 if kHook <> INVALID_HANDLE_VALUE then
  begin
   UnhookWindowsHookEx(kHook);
   Filer.WriteBuf('d:\dia\ownprojects\kLogger\test.txt',crlf+'Log finished');
  end;
end;
(*==============================================================================================*)
end.
Alar вне форума Ответить с цитированием
Старый 18.12.2019, 21:31   #5
Pavia
Лис
Старожил
 
Аватар для Pavia
 
Регистрация: 18.09.2015
Сообщений: 2,050
По умолчанию

NetSpace
Вот сделал программу. Основные отличия:
1) Поддержка AltGroup
2) Поддержка смены раскладки и переключения языка.
3) Обработка служебных клавиш, стрелки CTRL и тд.
4) Бонус, правильная передача сообщений клавиш в Memo.

Добавил обработку AltGroup - правый альт, используется в альтернативных раскладках клавиатуры для дополнительных клавиш. У меня там кавычки-ёлочки и прочие прелести. Так же клавиша AltGroup используется в белорусских и украинских раскладках может выбирать «i», «и» без смены языка.

Собственно сочетания служебных клавиш обрабатывает Memo. Поэтому конечно это не панацея, но большую часть отработает.

Можно ещё доработать сихронизацию, что-бы при смене активного окна вычитывать его содержимое.
Вложения
Тип файла: zip Логер клавиатуры.zip (217.0 Кб, 2 просмотров)
Хорошо поставленный вопрос это уже половина ответа. | Каков вопрос, таков ответ.
У дзен программиста программа делает то что он хотел, а не то что он написал .

Последний раз редактировалось Pavia; 18.12.2019 в 21:45.
Pavia на форуме Ответить с цитированием
Ответ

Здесь нужно купить рекламу за 20 тыс руб в месяц! ) пишите сюда - alarforum@yandex.ru
Без учёта ботов - 20000 человек в день, 350000 в месяц.

Опции темы


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Контроль программ (программы ограничивающие действия других программ) Bluezood Безопасность, Шифрование 3 16.01.2016 23:30
Блок поверх других (z-index не работает) amdbodia HTML и CSS 3 24.01.2012 19:33
Excel поверх других окон i777 Microsoft Office Excel 1 02.12.2010 01:32
Окно программы на VB5 поверх других окон Олег* Помощь студентам 0 01.03.2010 21:51
Блокирование других программ ar4i Общие вопросы Delphi 5 12.12.2006 15:59