G
gzcxylsj
Unregistered / Unconfirmed
GUEST, unregistred user!
各位好,我现在遇到一个问题,用IMM记录键盘输入记录怎么SendMessag()到一个控件上去显示,显示出来的是两个输入的键盘值.请各位指点一二帮忙解决....代码全部附在下面.
首先是的DLL的代码:
{DLL主程序:}
library DIMM;
{ 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,
Classes,
UnitGetkeyDll in 'UnitGetkeyDll.pas',
{$R *.res}
exports RemoveDll,InstallDll;
begin
end.
{DLL实现单元:}
unit UnitGetkeyDll;
interface
uses
windows,
messages,
sysutils,
tlhelp32,
imm,dialogs
forms;
const
MemNameGetkey = 'MemNameGetkey';
type
{内存映射文件记录结构}
TGetKeyMem = record
Count: integer; {字符字数}
LibHandle: integer; {GetKey.dll自己的句柄}
ExitIt:boolean;
Installhandle: Thandle;
end;
PGetKeyMem = ^TGetKeyMem;
procedure InstallDll(path:string;MainFormHandle,ExplorerProcessID:HWND);stdcall;
procedure RemoveDll;stdcall;
implementation
var
MemFile: THandle;
pShMem: PGetkeyMem;
HHCallWndProc,HHGetMsgProc: HHook;
procedure ShowInfo(str: string); stdcall;
var
str1: string;
buffer: array [0..5000] of char;
Str: integer;
begin
Sendmessage(pShMem^.Installhandle,$000D,5000,integer(@buffer)) ;{先获取原始数据}
str1 := String(buffer)+str;{原始数据加上新数据}
sendmessage(pShMem^.Installhandle,$000C,0,integer(str1)) ;{显示新的数据(即输入的数据)}
end;
function Keyboardhook(iCode:Integer;wParam:Longint;lParam:Longint): LRESULT;stdcall;
var
HIMC,fhWnd: HWND;
dwBufLen: DWORD;
pBuf : PChar;
ch: string;
LogFile: TextFile;
pcs: PCWPSTRUCT;
begin
case PCWPSTRUCT(lParam)^.message of
WM_IME_COMPOSITION: {测试只接收WM_IME_COMPOSITION类型的数据M_CHAR..WM_IME_CHAR类型的数据测试通过了}
begin
{先获取当前正在输入的窗口的输入法句柄}
fhWnd := PMsg(lParam)^.hwnd;
HIMC := ImmGetContext(fhWnd);
if HIMC = 0 then Exit;
{先将ImmGetCompositionString的获取长度设为0来获取字符串大小.}
dwBufLen := ImmGetCompositionString(HIMC,GCS_RESULTSTR,nil,0);
if dwBufLen > 0 then
begin
{ // 缓冲区大小要加上字符串的NULL结束符大小,
// 考虑到UNICODE}
inc(dwBufLen, sizeof(wchar));
GetMem(pBuf, dwBufLen);
{// 再调用一次.ImmGetCompositionString获取字符串}
ImmGetCompositionString(HIMC, GCS_RESULTSTR, pBuf, dwBufLen);
ShowInfo(pBuf);//显示到指定的窗体
ImmReleaseContext(PMsg(lParam)^.hwnd, HIMC);
end;
end;
end;
end;
procedure InstallDll(path:string;MainFormHandle,ExplorerProcessID:HWND);stdcall;
var
DC: HWND;
begin
pShMem^.Installhandle := ExplorerProcessID;
pShMem^.Count:=0;{按键个数}
{安装窗口消息钩子,用于截取中文输入}
if HHCallWndProc = 0 then
HHCallWndProc := SetWindowsHookEx(WH_CALLWNDPROC, Keyboardhook, hinstance, 0);
end;
procedure Intro;
begin
{建立内存映像文件,用于多过程的数据共享}
MemFile := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE, 0, SizeOf(TGetKeyMem), MemNameGetkey);
pShMem := MapViewOfFile(MemFile, FILE_MAP_WRITE or FILE_MAP_READ, 0, 0, 0);
end;
procedure Extro;
begin
if pShMem<>nil then
begin
UnmapViewOfFile(pShMem);
pShMem:=nil;
end;
if memfile<>0 then
begin
CloseHandle(MemFile);
MemFile:=0;
end;
end;
{动态连接库入口}
initialization
Intro;
finalization
Extro;
end.
{调用DLL主程序:}
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Findwidget, StdCtrls, ExtCtrls, ActnList, Menus;
type
TRecordKeyForm = class(TForm)
Memo1: TMemo;
procedure FormDestroy(Sender: TObject);
procedure FormShow(Sender: TObject);
private
procedure InstallHook;
public
{ Public declarations }
end;
procedure InstallDll(path:string;MainFormHandle,ExplorerProcessID:THandle);stdcall;external 'DIMM.dll';
procedure RemoveDll;stdcall;external 'DIMM.dll';
var
RecordKeyForm: TRecordKeyForm;
implementation
{$R *.dfm}
procedure TRecordKeyForm.InstallHook;
var
h, fHwnd:hWnd;
begin
fHwnd:=FindWindow('TRecordKeyForm',nil);
if fHwnd =0 then
begin
showmessage('没有找到类名为TMyForm的应用程序');
exit;
end;
h:=FindAllwidget(self.Handle); {查找EXPLORER.EXE的进程ID}
if h<>0 then
{第一个参数是当前目录,第二个参数是本窗口句柄,第三个参数是显示信息Memo1的句柄)}
InstallDll(extractfilepath(paramstr(0)),self.Handle,h);
end;
procedure TRecordKeyForm.FormDestroy(Sender: TObject);
begin
RemoveDll;//卸载钩子
end;
procedure TRecordKeyForm.FormShow(Sender: TObject);
begin
InstallHook;//安装钩子
end;
end.
首先是的DLL的代码:
{DLL主程序:}
library DIMM;
{ 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,
Classes,
UnitGetkeyDll in 'UnitGetkeyDll.pas',
{$R *.res}
exports RemoveDll,InstallDll;
begin
end.
{DLL实现单元:}
unit UnitGetkeyDll;
interface
uses
windows,
messages,
sysutils,
tlhelp32,
imm,dialogs
forms;
const
MemNameGetkey = 'MemNameGetkey';
type
{内存映射文件记录结构}
TGetKeyMem = record
Count: integer; {字符字数}
LibHandle: integer; {GetKey.dll自己的句柄}
ExitIt:boolean;
Installhandle: Thandle;
end;
PGetKeyMem = ^TGetKeyMem;
procedure InstallDll(path:string;MainFormHandle,ExplorerProcessID:HWND);stdcall;
procedure RemoveDll;stdcall;
implementation
var
MemFile: THandle;
pShMem: PGetkeyMem;
HHCallWndProc,HHGetMsgProc: HHook;
procedure ShowInfo(str: string); stdcall;
var
str1: string;
buffer: array [0..5000] of char;
Str: integer;
begin
Sendmessage(pShMem^.Installhandle,$000D,5000,integer(@buffer)) ;{先获取原始数据}
str1 := String(buffer)+str;{原始数据加上新数据}
sendmessage(pShMem^.Installhandle,$000C,0,integer(str1)) ;{显示新的数据(即输入的数据)}
end;
function Keyboardhook(iCode:Integer;wParam:Longint;lParam:Longint): LRESULT;stdcall;
var
HIMC,fhWnd: HWND;
dwBufLen: DWORD;
pBuf : PChar;
ch: string;
LogFile: TextFile;
pcs: PCWPSTRUCT;
begin
case PCWPSTRUCT(lParam)^.message of
WM_IME_COMPOSITION: {测试只接收WM_IME_COMPOSITION类型的数据M_CHAR..WM_IME_CHAR类型的数据测试通过了}
begin
{先获取当前正在输入的窗口的输入法句柄}
fhWnd := PMsg(lParam)^.hwnd;
HIMC := ImmGetContext(fhWnd);
if HIMC = 0 then Exit;
{先将ImmGetCompositionString的获取长度设为0来获取字符串大小.}
dwBufLen := ImmGetCompositionString(HIMC,GCS_RESULTSTR,nil,0);
if dwBufLen > 0 then
begin
{ // 缓冲区大小要加上字符串的NULL结束符大小,
// 考虑到UNICODE}
inc(dwBufLen, sizeof(wchar));
GetMem(pBuf, dwBufLen);
{// 再调用一次.ImmGetCompositionString获取字符串}
ImmGetCompositionString(HIMC, GCS_RESULTSTR, pBuf, dwBufLen);
ShowInfo(pBuf);//显示到指定的窗体
ImmReleaseContext(PMsg(lParam)^.hwnd, HIMC);
end;
end;
end;
end;
procedure InstallDll(path:string;MainFormHandle,ExplorerProcessID:HWND);stdcall;
var
DC: HWND;
begin
pShMem^.Installhandle := ExplorerProcessID;
pShMem^.Count:=0;{按键个数}
{安装窗口消息钩子,用于截取中文输入}
if HHCallWndProc = 0 then
HHCallWndProc := SetWindowsHookEx(WH_CALLWNDPROC, Keyboardhook, hinstance, 0);
end;
procedure Intro;
begin
{建立内存映像文件,用于多过程的数据共享}
MemFile := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE, 0, SizeOf(TGetKeyMem), MemNameGetkey);
pShMem := MapViewOfFile(MemFile, FILE_MAP_WRITE or FILE_MAP_READ, 0, 0, 0);
end;
procedure Extro;
begin
if pShMem<>nil then
begin
UnmapViewOfFile(pShMem);
pShMem:=nil;
end;
if memfile<>0 then
begin
CloseHandle(MemFile);
MemFile:=0;
end;
end;
{动态连接库入口}
initialization
Intro;
finalization
Extro;
end.
{调用DLL主程序:}
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Findwidget, StdCtrls, ExtCtrls, ActnList, Menus;
type
TRecordKeyForm = class(TForm)
Memo1: TMemo;
procedure FormDestroy(Sender: TObject);
procedure FormShow(Sender: TObject);
private
procedure InstallHook;
public
{ Public declarations }
end;
procedure InstallDll(path:string;MainFormHandle,ExplorerProcessID:THandle);stdcall;external 'DIMM.dll';
procedure RemoveDll;stdcall;external 'DIMM.dll';
var
RecordKeyForm: TRecordKeyForm;
implementation
{$R *.dfm}
procedure TRecordKeyForm.InstallHook;
var
h, fHwnd:hWnd;
begin
fHwnd:=FindWindow('TRecordKeyForm',nil);
if fHwnd =0 then
begin
showmessage('没有找到类名为TMyForm的应用程序');
exit;
end;
h:=FindAllwidget(self.Handle); {查找EXPLORER.EXE的进程ID}
if h<>0 then
{第一个参数是当前目录,第二个参数是本窗口句柄,第三个参数是显示信息Memo1的句柄)}
InstallDll(extractfilepath(paramstr(0)),self.Handle,h);
end;
procedure TRecordKeyForm.FormDestroy(Sender: TObject);
begin
RemoveDll;//卸载钩子
end;
procedure TRecordKeyForm.FormShow(Sender: TObject);
begin
InstallHook;//安装钩子
end;
end.