输入法注入之delphi版

Question

  网上看到C++版本改的，改成delphi的有一点需要注意，就是除了实现接口外还要改版本信息里的一个键值才能安装成功，貌似这点MSDN上没说，delphi恰好也没提供这个键值的修改方法。
  http://user.qzone.qq.com/156710661/blog/1282717245 赚点人气，呵呵，希望不要介意！

Answer 1

 看到现在很流行输入法注入，但是找不到delphi版本的，所以参考C++的做了delphi版的。注入需要3个文件，一个是控制程序用来安装输入法，卸载输入法;一个是什么也不做的输入法程序;一个是要注入的dll。虽然现在很多杀毒软件都对这个做了拦截，但在有的时候还有有用的。
  输入法程序其实就是一个dll，不过这个dll要导出19个微软要求的函数：
  ImeConversionList,
  ImeConfigure,
  ImeDestroy,
  ImeEscape,
  ImeInquire,
  ImeProcessKey,
  ImeSelect,
  ImeSetActiveContext,
  ImeSetCompositionString,
  ImeToAsciiEx,
  NotifyIME,
  ImeRegisterWord,
  ImeUnregisterWord,
  ImeGetRegisterWordStyle,
  ImeEnumRegisterWord,
  UIWndProc,
  StatusWndProc,
  CompWndProc,
  CandWndProc;
  不过仅仅实现所有要求的接口，调用ImmInstallIME安装还是会失败，还有两点需要注意的，其一就是需要将扩展名由.dll改成.ime并复制到系统目录下(XP下是system32)，还有一点是笔者找了很长时间才发现的，那就是输入法程序必须包含版本信息，且版本信息里的文件类型必须为驱动程序，子类型为输入方法。但是delphi的工程选项里没有设置文件类型的(至少delphi2007没有)，所以只能用VS的资源编辑工具将文件类型修改成驱动程序。控制程序通过文件映射与输入法通信，以便告知输入法要注入哪一个dll，注入哪一个进程，并用事件对象同步dll的注入。
  整个流程如下：
  1.创建一个文件映射对象，映射到内存，写入需要注入的dll名称，进程ID
  2.保存原有默认输入法句柄，复制输入法程序到系统目录，并调用ImmInstallIME安装输入法
  3.创建事件对象，以便同步dll的加载与卸载。
  4.向目标进程的窗口句柄发送WM_INPUTLANGCHANGEREQUEST消息，lParam为输入法句柄
  5.等待注入完成，广播WM_INPUTLANGCHANGEREQUEST消息，lParam为原有默认输入法句柄
  6.等待输入法引用计数归0
  7.卸载输入法，释放事件对象。
源代码下载地址：http://download.csdn.net/source/2645745

Answer 2

控制程序unit FrmMain;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Imm, StdCtrls, ImeInjectShare, Registry, codesitelogging;
const
  WM_INPUTLANGCHANGEREQUEST = $0050;
type
  TFormMain = class(TForm)
    EdtWindowTitle: TEdit;
    BtnInject: TButton;
    Label1: TLabel;
    Label2: TLabel;
    EdtDllPath: TEdit;
    BtnSelect: TButton;
    DlgOpen: TOpenDialog;
    procedure BtnSelectClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure BtnInjectClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  FormMain: TFormMain;
  FileMapHandle: THandle;implementation{$R *.dfm}procedure TFormMain.BtnInjectClick(Sender: TObject);
var
  SysDir: array[0..MAX_PATH] of Char;
  InjectWindowHandle: THandle;
  InjectProcessId: DWORD;
  LoadDllEvent: THandle;
  UnLoadDllEvent: THandle;
  DefaultImeHandle: THandle;
  ImeHandle: THandle;
  ImeId: string;
  ImePath: string;
begin
  //找到窗口句柄
  InjectWindowHandle := FindWindow(nil, PChar(EdtWindowTitle.Text));
  if InjectWindowHandle > 0 then
  begin
    //找到需要注入的进程ID
    GetWindowThreadProcessId(InjectWindowHandle, InjectProcessId);
    if InjectProcessId > 0 then
    begin
      //设置共享内存，并写入注入信息
      if FileMapHandle > 0 then
        CloseHandle(FileMapHandle);
      CreateImeInjectShareMemory(PChar(EdtDllPath.Text), InjectProcessId,
        FileMapHandle);
      if FileMapHandle > 0 then
      begin
        //保存原来的默认输入法
        SystemParametersInfo(SPI_GETDEFAULTINPUTLANG, 0, @DefaultImeHandle, 0);
        //获取系统目录
        ZeroMemory(@SysDir, MAX_PATH);
        GetSystemDirectory(@SysDir, MAX_PATH);
        ImePath := string(SysDir) + '\MythIme.ime';
        //复制输入法文件到系统目录
        if CopyFile(PChar(ExtractFilePath(Application.ExeName) + 'MythIme.ime'),
          PChar(ImePath), False) then
        begin
          //安装输入法
          ImeHandle := ImmInstallIME(PChar(ImePath), '神话输入法');
          if ImeHandle > 0 then
          begin
            //创建事件，同步dll注入
            UnLoadDllEvent := CreateEvent(nil, True, True, GUID_UNLOADDLL);
            LoadDllEvent := CreateEvent(nil, True, False, GUID_LOADDLL);
            //向目标窗口发送激活输入法的消息
            PostMessage(InjectWindowHandle, WM_INPUTLANGCHANGEREQUEST, 0,
              ImeHandle);
            //等待注入完成
            if WaitForSingleObject(LoadDllEvent, 3000) = WAIT_OBJECT_0 then
            begin
              //广播消息，使我们的输入法卸载
              PostMessage(HWND_BROADCAST, WM_INPUTLANGCHANGEREQUEST, 0,
                DefaultImeHandle);
              //等待输入法卸载
              if WaitForSingleObject(UnLoadDllEvent, 3000) = WAIT_OBJECT_0 then
              begin
                ShowMessage('注入成功！');
              end;
            end;
            //卸载输入法
            UnloadKeyboardLayout(ImeHandle);
            DeleteFile(ImePath);
            CloseHandle(UnLoadDllEvent);
            CloseHandle(LoadDllEvent);
          end;
        end;
      end;
    end;
  end;
end;procedure TFormMain.BtnSelectClick(Sender: TObject);
begin
  if DlgOpen.Execute then
  begin
    EdtDllPath.Text := DlgOpen.FileName;
  end;
end;procedure TFormMain.FormDestroy(Sender: TObject);
begin
  if FileMapHandle > 0 then
    CloseHandle(FileMapHandle);
end;end.

Answer 3

unit ImeInjectShare;interfaceuses Windows,SysUtils;const
  GUID_SHAREMEMORY='{5E183D3E-049A-4CDC-BA47-C71342BF6663}';
  GUID_LOADDLL='{DA97DEE2-6393-480E-80C0-F053568C5B38}';
  GUID_UNLOADDLL='{1E99EEB2-29B9-469B-8C90-559B92F42A29}';
type
  //用来设置注入参数的共享区域
  PImeInjectShareMemory = ^TImeInjectShareMemory;
  TImeInjectShareMemory = packed record
    DllName: array[0..MAX_PATH] of Char;//注入的dll路径
    ProcessId: DWORD;//注入的进程ID
  end;
  
//设置注入参数，由控制程序调用
procedure CreateImeInjectShareMemory(DllName: string; ProcessId: DWORD;
  var FileMapHandle:THandle);//获取注入参数，由输入法dll调用
procedure GetImeInjectShareMemory(ImeInjectShareMemory:PImeInjectShareMemory);implementationprocedure CreateImeInjectShareMemory(DllName: string; ProcessId: DWORD;
  var FileMapHandle:THandle);
var
  ShareMemory:PImeInjectShareMemory;
begin
  FileMapHandle:=0;
  FileMapHandle := CreateFileMapping(INVALID_HANDLE_VALUE, nil, PAGE_READWRITE,
    0,SizeOf(TImeInjectShareMemory),GUID_SHAREMEMORY);
  if FileMapHandle > 0 then
  begin
    ShareMemory:=MapViewOfFile(FileMapHandle,FILE_MAP_ALL_ACCESS,0,0,0);
    if ShareMemory<>nil then
    begin
      ZeroMemory(ShareMemory,SizeOf(TImeInjectShareMemory));
      StrLCopy(PChar(ShareMemory),PChar(DllName),MAX_PATH-1);
      ShareMemory.ProcessId:=ProcessId;
      UnmapViewOfFile(ShareMemory);
    end;
  end;
end;procedure GetImeInjectShareMemory(ImeInjectShareMemory:PImeInjectShareMemory);
var
  FileMapHandle:THandle;
  ShareMemory:PImeInjectShareMemory;
begin
  ZeroMemory(ImeInjectShareMemory,SizeOf(TImeInjectShareMemory));
  FileMapHandle:=OpenFileMapping(FILE_MAP_READ,False,GUID_SHAREMEMORY);
  if FileMapHandle>0 then
  begin
    ShareMemory:=MapViewOfFile(FileMapHandle,FILE_MAP_READ,0,0,0);
    if ShareMemory<>nil then
    begin
      CopyMemory(ImeInjectShareMemory,ShareMemory,SizeOf(TImeInjectShareMemory));
      UnmapViewOfFile(ShareMemory);
    end;
    CloseHandle(FileMapHandle);
  end;
end;end.

Answer 4

library MythIme;uses
  Windows,
  SysUtils,
  Classes,
  ImeMain in 'ImeMain.pas',
  ImeInjectShare in 'ImeInjectShare.pas';{$E ime}
{$R *.res}procedure MyDllProc(Reason: Integer);
var
  LoadDllEvent:THandle;
  UnLoadDllEvent:THandle;
begin
  case Reason of
    DLL_PROCESS_ATTACH:
      begin
        UnLoadDllEvent:=OpenEvent(EVENT_ALL_ACCESS,False,GUID_UNLOADDLL);
        if UnLoadDllEvent>0 then
        begin
          ResetEvent(UnLoadDllEvent);
        end;
        RegisterImeWindow;
        GetImeInjectShareMemory(@ShareMemory);
        //判断宿主进程是否是我们想注入的进程
        if ShareMemory.ProcessId=GetCurrentProcessId then
        begin
          LoadLibrary(@ShareMemory.DllName);
          //通知控制程序，我们已经注入啦
          LoadDllEvent:=OpenEvent(EVENT_ALL_ACCESS,False,GUID_LOADDLL);
          if LoadDllEvent>0 then
          begin
            SetEvent(LoadDllEvent);
          end;
        end;
      end;
    DLL_THREAD_ATTACH:
      begin      end;
    DLL_THREAD_DETACH:
      begin      end;
    DLL_PROCESS_DETACH:
      begin
        UnRegisterImeWindow;
        //通知控制程序我们离开了
        UnLoadDllEvent:=OpenEvent(EVENT_ALL_ACCESS,False,GUID_UNLOADDLL);
        if UnLoadDllEvent>0 then
        begin
          SetEvent(UnLoadDllEvent);
        end;
      end;
  end;
end;exports
  ImeConversionList,
  ImeConfigure,
  ImeDestroy,
  ImeEscape,
  ImeInquire,
  ImeProcessKey,
  ImeSelect,
  ImeSetActiveContext,
  ImeSetCompositionString,
  ImeToAsciiEx,
  NotifyIME,
  ImeRegisterWord,
  ImeUnregisterWord,
  ImeGetRegisterWordStyle,
  ImeEnumRegisterWord,
  UIWndProc,
  StatusWndProc,
  CompWndProc,
  CandWndProc;
begin
  DllProc := @MyDllProc;
  MyDllProc(DLL_PROCESS_ATTACH);
end.
unit ImeMain;interfaceuses Windows,SysUtils,Classes,Imm,ImeInjectShare;const
  IME_WINDOWCLASSNAME='MythImeWindow';
  IME_SMODE_NONE=$0000;
  UI_CAP_2700=$00000001;
  SELECT_CAP_CONVERSION=$00000001;
  // IME property bits
  IME_PROP_END_UNLOAD=$00000001;
  IME_PROP_KBD_CHAR_FIRST=$00000002;
  IME_PROP_IGNORE_UPKEYS=$00000004;
  IME_PROP_NEED_ALTKEY=$00000008;
  IME_PROP_NO_KEYS_ON_CLOSE=$00000010;
  IME_PROP_AT_CARET=$00010000;
  IME_PROP_SPECIAL_UI=$00020000;
  IME_PROP_CANDLIST_START_FROM_1=$00040000;
  IME_PROP_UNICODE=$00080000;
  IME_PROP_COMPLETE_ON_UNSELECT=$00100000;
type
  PImeInfo=^TImeInfo;
  TImeInfo=record
    dwPrivateDataSize:DWORD;
    fdwProperty:DWORD;
    fdwConversionCaps:DWORD;
    fdwSentenceCaps:DWORD;
    fdwUICaps:DWORD;
    fdwSCSCaps:DWORD;
    fdwSelectCaps:DWORD;
  end;
  PTransMsg = ^TTransMsg;
  TTransMsg = record
    message: uInt;
    wParam: WParam;
    lParam: LParam;
  end;
  PTransMsgList = ^TTransMsgList;
  TTransMsgList = record
    uMsgCount: uInt;
    TransMsg: array[0..0] of TTransMsg;
  end;
  PPrivContext = ^TPrivContext;
  TPrivContext = record
    iImeState: Integer; // the composition state - input, choose, or
    fdwImeMsg: DWord;   // what messages should be generated
    dwCompChar: DWord;  // wParam of WM_IME_COMPOSITION
    fdwGcsFlag: DWord;  // lParam for WM_IME_COMPOSITION
    uSYHFlg: uInt;
    uDYHFlg: uInt;
    uDSMHCount: uInt;
    uDSMHFlg: uInt;
    bSeq: array[0..12] of Char; // sequence code of input char
    fdwGB: DWord;
  end;  
function RegisterImeWindow:BOOL;
procedure UnRegisterImeWindow;
//输入法必须要的19个接口
function ImeConversionList(hImc:HIMC;lpSource:PChar;lpCandList:PCandidateList;
  uBufLen,uFlag:UINT):DWORD;stdcall;
function ImeConfigure(hKl:HKL;hWnd:HWND;dwMode:DWORD;lpData:Pointer)
  :BOOL;stdcall;
function ImeDestroy(uForce:UINT):BOOL;stdcall;
function ImeEscape(hImc:HIMC;uSubFunc:UINT;lpData:PChar):LRESULT;stdcall;
function ImeInquire(lpImeInfo:PImeInfo;lpszUIClass:PChar;lpszOption:DWORD)
  :BOOL;stdcall;
function ImeProcessKey(hImc:HIMC;uKey:UINT;lKeyData:LPARAM;
  lpbKeyState:PKeyboardState):BOOL;stdcall;
function ImeSelect(hImc:HIMC;fSelect:BOOL):BOOL;stdcall;
function ImeSetActiveContext(hImc:HIMC;fFlag:BOOL):BOOL;stdcall;
function ImeSetCompositionString(hImc:HIMC;dwIndex:DWORD;lpComp:Pointer;
  dwComp:DWORD;lpRead:Pointer;dwRead:DWORD):BOOL;stdcall;
function ImeToAsciiEx(uVKey,uScanCode:UINT;lpbKeyState:PKeyboardState;
  lpdwTransKey:PTransMsgList;fuState:UINT;hImc:HIMC):UINT;stdcall;
function NotifyIME(hImc:HIMC;dwAction:DWORD;dwIndex:DWORD;
  dwValue:DWORD):BOOL;stdcall;
function ImeRegisterWord(lpszReading:PChar;dwStyle:DWORD;lpszString:PChar)
  :BOOL;stdcall;
function ImeUnregisterWord(lpszReading:PChar;dwStyle:DWORD;lpszString:PChar)
  :BOOL;stdcall;
function ImeGetRegisterWordStyle(nItem:UINT;lpStyleBuf:PStyleBuf):UINT;stdcall;
function ImeEnumRegisterWord(lpfnRegisterWordEnumProc:RegisterWordEnumProc;
  lpszReading:PChar;dwStyle:DWORD;lpszString:PChar;lpData:Pointer):UINT;stdcall;
function UIWndProc(hWnd:HWND;Msg:UINT;wParam:WPARAM;lParam:LPARAM)
  :LRESULT;stdcall;
function StatusWndProc(hWnd:HWND;Msg:UINT;wParam:WPARAM;lParam:LPARAM)
  :LRESULT;stdcall;
function CompWndProc(hWnd:HWND;Msg:UINT;wParam:WPARAM;lParam:LPARAM)
  :LRESULT;stdcall;
function CandWndProc(hWnd:HWND;Msg:UINT;wParam:WPARAM;lParam:LPARAM)
  :LRESULT;stdcall;var
  ShareMemory:TImeInjectShareMemory;implementationfunction RegisterImeWindow:BOOL;
var
  wc:WNDCLASSEX;
begin
  wc.style:=CS_IME or CS_VREDRAW or CS_HREDRAW or CS_DBLCLKS;
  wc.lpfnWndProc:=@UIWndProc;
  wc.cbClsExtra:=0;
  wc.cbWndExtra:=0;
  wc.hInstance:=HInstance;
  wc.hIcon:=0;
  wc.hCursor:=LoadCursor(0, IDC_ARROW );
  wc.hbrBackground:=GetStockObject(WHITE_BRUSH);
  wc.lpszMenuName:=nil;
  wc.lpszClassName:=IME_WINDOWCLASSNAME;
  wc.hIconSm:=0;
  Result:=Windows.RegisterClassEx(wc)<>0;
end;procedure UnRegisterImeWindow;
begin
  Windows.UnregisterClass(IME_WINDOWCLASSNAME,HInstance);
end;function ImeConversionList(hImc:HIMC;lpSource:PChar;lpCandList:PCandidateList;
  uBufLen,uFlag:UINT):DWORD;
begin
  Result:=0;
end;function ImeConfigure(hKl:HKL;hWnd:HWND;dwMode:DWORD;lpData:Pointer):BOOL;
begin
  Result:=dwMode=IME_CONFIG_GENERAL;
end;function ImeDestroy(uForce:UINT):BOOL;
begin
  Result:=not BOOL(uForce);
end;function ImeEscape(hImc:HIMC;uSubFunc:UINT;lpData:PChar):LRESULT;
begin
  Result:=0;
end;function ImeInquire(lpImeInfo:PImeInfo;lpszUIClass:PChar;lpszOption:DWORD):BOOL;
begin
  Result := False;
  lpImeInfo.dwPrivateDataSize:=SizeOf(TPrivContext);
  lpImeInfo.fdwProperty:=IME_PROP_KBD_CHAR_FIRST or IME_PROP_IGNORE_UPKEYS;
  lpImeInfo.fdwConversionCaps:=IME_CMODE_FULLSHAPE or IME_CMODE_NATIVE;
  lpImeInfo.fdwSentenceCaps:=IME_SMODE_NONE;
  lpImeInfo.fdwUICaps:=UI_CAP_2700;
  lpImeInfo.fdwSCSCaps:=0;
  lpImeInfo.fdwSelectCaps:=SELECT_CAP_CONVERSION;
  StrCopy(lpszUIClass,IME_WINDOWCLASSNAME);
  Result:=True;
end;function ImeProcessKey(hImc:HIMC;uKey:UINT;lKeyData:LPARAM;
  lpbKeyState:PKeyboardState):BOOL;
begin
  Result:=False;
end;function ImeSelect(hImc:HIMC;fSelect:BOOL):BOOL;
begin
  Result:=True;
end;function ImeSetActiveContext(hImc:HIMC;fFlag:BOOL):BOOL;
begin
  Result:=True;
end;
function ImeSetCompositionString(hImc:HIMC;dwIndex:DWORD;lpComp:Pointer;
  dwComp:DWORD;lpRead:Pointer;dwRead:DWORD):BOOL;
begin
  Result:=False;
end;function ImeToAsciiEx(uVKey,uScanCode:UINT;lpbKeyState:PKeyboardState;
  lpdwTransKey:PTransMsgList;fuState:UINT;hImc:HIMC):UINT;
begin
  Result:=0;
end;function NotifyIme(hImc:HIMC;dwAction:DWORD;dwIndex:DWORD;
  dwValue:DWORD):BOOL;
begin
  Result:=False;
end;function ImeRegisterWord(lpszReading:PChar;dwStyle:DWORD;lpszString:PChar):BOOL;
begin
  Result:=False;
end;function ImeUnregisterWord(lpszReading:PChar;dwStyle:DWORD;lpszString:PChar)
  :BOOL;
begin
  Result:=False;
end;function ImeGetRegisterWordStyle(nItem:UINT;lpStyleBuf:PStyleBuf):UINT;
begin
  Result:=0;
end;function ImeEnumRegisterWord(lpfnRegisterWordEnumProc:RegisterWordEnumProc;
  lpszReading:PChar;dwStyle:DWORD;lpszString:PChar;lpData:Pointer):UINT;
begin
  Result:=0;
end;function UIWndProc(hWnd:HWND;Msg:UINT;wParam:WPARAM;lParam:LPARAM):LRESULT;
begin
  Result:=0;
end;function StatusWndProc(hWnd:HWND;Msg:UINT;wParam:WPARAM;lParam:LPARAM):LRESULT;
begin
  Result:=0;
end;function CompWndProc(hWnd:HWND;Msg:UINT;wParam:WPARAM;lParam:LPARAM):LRESULT;
begin
  Result:=0;
end;function CandWndProc(hWnd:HWND;Msg:UINT;wParam:WPARAM;lParam:LPARAM):LRESULT;
begin
  Result:=0;
end;
end.

Answer 5

Delphi编译的时候可以直接添加版本信息（Project、Options、include version information in project），不需要“用VS的资源编辑工具”后改啊。

Answer 6

文件类型和子类型，delphi没有这个键值，只能选择dll或非dll

Answer 7

貌似这点MSDN上没说，delphi恰好也没提供这个键值的修改方法

Answer 8

Delphi代码看起来一直那么优雅

Answer 9

只懂一点delphi写个一般的云台控制之类！你这个真是让我膜拜啊！太牛了！

Answer 10

file://C:\Documents and Settings\Administrator\Local Settings\Temporary Internet Files\Content.IE5\01AZ7BUR\79[1].gif

Answer 11

好久没有看过DELPHI的好东西了.

Answer 12

输入法程序必须包含版本信息，且版本信息里的文件类型必须为驱动程序，子类型为输入方法。这个非常重要，用资源查看工具查下生成的ime文件是否符合这个条件！