》》》》》已经等了30天的问题：如何通过输入法（用api）反查汉字编码？？？

编程实现自动标注汉语拼音
　作者：　北京 Daffodil 　 11月27日　　16：14
在使用电脑编辑文档的时候，输入汉语拼音再加上它的声调，是一件令人头痛的事情，特别对于那些经常接触拼音的教师、家长和孩子。虽然 Office XP中已经加入了自动标注汉语拼音的功能，不过，Office XP要####.00元哦。对于没有用上Office XP的人来说，难道就没有办法享受到这种便利吗？好在我们学习了编程，就自己动手吧！这篇文章不仅仅是说明如何实现自动标注汉语拼音编程的，我的主要目的是演示解决问题的一般步骤。就本问题来说，你是不是有种不知如何下手的感觉？想一想我们在编写汉字GB－BIG5相互转化时的做法：把每一个汉字的GB码、BIG5码都列出来，并一一对应。我们可以仿照这种方法，把每一个汉字（至少6763 个！！！）对应的拼音都列出来，然后就可以查询了。不过，我相信你和我一样是懒惰的，懒惰的人通常会花费几倍的时间去找个可以懒惰的办法来。最懒惰的办法是……捡个现成的！先到网上问问看，就选大富翁论坛吧。这里不是大富翁游戏爱好者交流经验的论坛，而是专门讨论Delphi编程的地方，人气也好。登录http://www.delphibbs. com，**注个册，问问看有没有谁知道如何编，或者能提供个组件什么的。记住要选邮件通知，如果有人回答问题，论坛会自动发邮件通知你，然后你就等着吧。闲着也是闲着，在等待的时候我们也该做点什么。首先，应该想到 MSDN，它可是程序员必备的编程参考书（软件）。在MSDN中输入spell 或phoneticize查一下，看看有没有我们想要的信息。你就沿着这条思路试试吧。
还可以想一想，我们以前使用电脑接触到有拼音的地方。输入法！对了，就是拼音输入法！输入拼音我们可以得到汉字。我们能不能通过一种逆运算，输入汉字得到这个汉字的拼音？回答当然是肯定的，这也是本文推荐的方法。这种方法实际上就是得到汉字的字根。我们仍然可以上论坛去询问，到 MSDN中查找，不过问题要改为“如何得到汉字的字根”。不用说，你已经可以解决本问题了。实际上，此编程主要用到三个函数: GetKeyboardLayoutList：得到当台计算机中存在的输入法列表； ImmEscape ：得到输入法的名称; ImmGetConversionList: 看看这个输入法是否支持Reverse Conversion功能，如果支持则继续使用此函数，可取得组字字根信息。现在简单了，打开Delphi 6，添加两个TEdit控件、三个TBitBtn控件、一个TOpenDialog控件以及若干 Label控件以示说明，窗体设计如图1所示。接着输入下面的源代码，编译通过就可以使用了。主要的地方我已经加了注释。在编译之前，请确定你安装了微软拼音输入法。 unit Unit1;
interface
uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, Buttons, IMM; type TForm1 = class(TForm) OpenDialog1: TOpenDialog; BitBtn2: TBitBtn; BitBtn3: TBitBtn; Edit2: TEdit; Edit1: TEdit; Label5: TLabel; Label1: TLabel; BitBtn1: TBitBtn; procedure BitBtn1Click(Sender: TObject); procedure FormCreate(Sender: TObject); procedure BitBtn3Click(Sender: TObject); procedure BitBtn2Click(Sender: TObject); public iHandleCount: integer; pList : array[1..20] of HKL; szImeName : array[0..254] of char; II : integer; end;
const pych: array[1..6,1..5] of string[2]= (('ā', 'á','ǎ','à','a'),('ō', 'ó','ǒ','ò','o'), ('ē', 'é','ě','è','e'),('ī', 'í','ǐ','ì','i'), ('ū', 'ú','ǔ','ù','u'),('ǖ', 'ǘ','ǚ','ǜ','ü'));
var Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject); var i: integer; begin II := 0; //retrieves the keyboard layout handles corresponding to the current set of input locales in the system. iHandleCount := GetKeyboardLayoutList(20, pList); for i := 1 to iHandleCount do begin if ImmEscape(pList[i], 0, IME_ESC_IME_NAME, @szImeName) > 0 then if szImeName='微软拼音输入法' then begin
StdCtrls, ExtCtrls, Buttons, IMM; type TForm1 = class(TForm) OpenDialog1: TOpenDialog; BitBtn2: TBitBtn; BitBtn3: TBitBtn; Edit2: TEdit; Edit1: TEdit; Label5: TLabel; Label1: TLabel; BitBtn1: TBitBtn; procedure BitBtn1Click(Sender: TObject); procedure FormCreate(Sender: TObject); procedure BitBtn3Click(Sender: TObject); procedure BitBtn2Click(Sender: TObject); public iHandleCount: integer; pList : array[1..20] of HKL; szImeName : array[0..254] of char; II : integer; end;
const pych: array[1..6,1..5] of string[2]= (('ā', 'á','ǎ','à','a'),('ō', 'ó','ǒ','ò','o'), ('ē', 'é','ě','è','e'),('ī', 'í','ǐ','ì','i'), ('ū', 'ú','ǔ','ù','u'),('ǖ', 'ǘ','ǚ','ǜ','ü'));
var Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject); var i: integer; begin II := 0; //retrieves the keyboard layout handles corresponding to the current set of input locales in the system. iHandleCount := GetKeyboardLayoutList(20, pList); for i := 1 to iHandleCount do begin if ImmEscape(pList[i], 0, IME_ESC_IME_NAME, @szImeName) > 0 then if szImeName='微软拼音输入法' then begin
ii := i; exit; end; end; ShowMessage('请你安装"微软拼音输入法"!'); end;
// 选择需要标注拼音的文件： procedure TForm1.BitBtn1Click(Sender: TObject); begin OpenDialog1.Title := '选择需要转换的文件'; if OpenDialog1.Execute then Edit1.Text := OpenDialog1.FileName; Edit2.Text := ChangeFileExt(OpenDialog1.FileName, '.py'); end;

// 拼音文件保存到 procedure TForm1.BitBtn3Click(Sender: TObject); begin OpenDialog1.Title := '转换到：'; if OpenDialog1.Execute then Edit2.Text := OpenDialog1.FileName; end;
procedure TForm1.BitBtn2Click(Sender: TObject); var f1 ,f2 :textfile; ch1,ch2,ch11 :Char; ch2Str :string; j ,alr , tmp :integer; py : array[1..6] of integer; function QueryCompStr(hKB: HKL; const sChinese: AnsiString): string; var dwGCL: DWORD; szBuffer: array[0..254] of char; iMaxKey, iStart, i: integer; begin Result := ''; iMaxKey := ImmEscape(hKB, 0, IME_ESC_MAX_KEY, nil); if iMaxKey <= 0 then exit;
// 看看这个输入法是否支持Reverse Conversion功能，同时, 侦测需要多大的空间容纳取得的信息 dwGCL := ImmGetConversionList(hKB, 0, pchar(sChinese),nil, 0, GCL_REVERSECONVERSION); if dwGCL <= 0 then Exit; // 该输入法不支持Reverse Conversion功能
// 取得组字字根信息, dwGCL的值必须用上次呼叫ImmGetConversionList得到的返回值作为参数 dwGCL := ImmGetConversionList(hKB,0,pchar(sChinese),@szBuffer, dwGCL,GCL_REVERSECONVERSION);
if dwGCL > 0 then begin iStart := byte(szBuffer[24]); for i := iStart to iStart + iMaxKey * 2 do AppendStr(Result, szBuffer[i]);
end; end; begin tmp:=0; if not FileExists(Edit1.text)then begin ShowMessage('请你选定一个文件或你'#13#10'选择的文件不存在！'); exit; end;
AssignFile(F1, edit1.Text); Reset(F1); AssignFile(F2, edit2.Text); Rewrite(F2);
while not Eof(F1) do begin alr:=0; Read(F1, Ch1); if not IsDBCSLeadByte(byte(ch1)) then begin Write(F2, Ch1); continue; end; //if Read(F1, Ch11); ch2str:= QueryCompStr(pList[ii], ch1+ch11); if (ch2str[1]=#0)then begin Write(F2, Ch1); Write(F2, Ch11); continue; end;
for J:=1 to 8 do begin if (ch2str[j]<'6')and (ch2str[j]>'0') then tmp:=strtoint(ch2str[j]); end;
for j:=1 to 6 do py[j]:=0; //以下是判断加拼音的位置，注意ui和iu加声调的方式 for j:=8 downto 1 do begin if ch2str[j]='a' then py[1]:=1; if ch2str[j]='o' then py[2]:=1; if ch2str[j]='e' then py[3]:=1; if (ch2str[j]='i') and (py[5]<>1)then py[4]:=1; if (ch2str[j]='u') and (py[4]<>1) then py[5]:=1; if ch2str[j]='ü' then py[6]:=1; end;
for J:=1 to 8 do begin
end; //if if (ch2='o') and (alr=0) and (py[1]<>1) then begin alr:=1; Write(F2, pych[2][tmp]); continue; end;
if (ch2='e') then begin alr:=1; Write(F2, pych[3][tmp]); continue; end;
if (ch2='i')and (alr=0) and (py[1]<>1) and (py[2]<>1) and (py[3]<>1) and (py[4]=1) then begin alr:=1; Write(F2, pych[4][tmp]); continue; end;
if (ch2='u')and (alr=0) and (py[1]<>1) and (py[2]<>1) and (py[3]<>1) and (py[5]=1) then begin alr:=1; Write(F2, pych[5][tmp]); continue; end;
if (ch2='ü')and (alr=0)and (py[3]<>1) then begin alr:=1; Write(F2, pych[6][tmp]); continue; end;
Write(F2, Ch2); end; //for write(f2,' '); end; //while CloseFile(F2); CloseFile(F1); ShowMessage('转换完毕!'); end; end. 程序中判断加拼音的位置的方法有些笨拙，所幸还能用。如果你写出了更有效率的代码，希望能和大家一起分享。有一个要注意的地方，程序还不能处理多音字。另外，你可以在程序中添加进度条，以了解程序的进度。程序在Delphi6 + Windows98下调试通过。

“微软拼音输入法”可以反查，但王码五笔没有找到办法
即dwGCL := ImmGetConversionList(hKB, 0, pchar(sChinese),nil, 0, GCL_REVERSECONVERSION); if dwGCL <= 0 then Exit; // 该输入法不支持Reverse Conversion功能但是“控制面板”中可以设置“编码查询”来查五笔的编码，不知道这是怎么回事

多谢rainstormmaster(rainstormmaster)
能说说该“八股文”的格式吗

window提供了一个工具，输入法生成器，用它把输入法对应的.mb文件逆向输出为txt文件

下面代码演示根据微软拼音输入法反查汉语拼音（以前发现代码，我修改了其中一些bug（字符编码问题））
Option Explicit
Const GCL_CONVERSION = 1
Const GCL_REVERSECONVERSION = 2Const VER_PLATFORM_WIN32_WINDOWS = 1
Const VER_PLATFORM_WIN32_NT = 2Private Const IME_ESC_MAX_KEY = &H1005
Private Const IME_ESC_IME_NAME = &H1006
Type CANDIDATELIST
  dwSize As Long
  dwStyle As Long
  dwCount As Long
  dwSelection As Long
  dwPageStart As Long
  dwPageSize As Long
  dwOffset(0) As Long
End TypeDeclare Function ImmGetContext Lib "imm32" ( _
    ByVal hWnd As Long _
) As LongDeclare Function ImmReleaseContext Lib "imm32" ( _
    ByVal hWnd As Long, _
    ByVal hIMC As Long _
) As LongDeclare Function ImmGetConversionList Lib "imm32" Alias "ImmGetConversionListW" ( _
    ByVal hKL As Long, _
    ByVal hIMC As Long, _
    ByRef lpSrc As Byte, _
    ByRef lpDst As Any, _
    ByVal dwBufLen As Long, _
    ByVal uFlag As Long _
) As LongDeclare Function GetKeyboardLayout Lib "user32" ( _
    ByVal idThread As Long _
) As Long
Private Declare Function GetKeyboardLayoutList Lib "user32" _
   (ByVal nBuff As Long, _
    ByRef lpList As Long) As Long

Private Declare Function ImmEscape Lib "imm32.dll" _
    Alias "ImmEscapeA" _
   (ByVal hKL As Long, _
    ByVal hIMC As Long, _
    ByVal un As Long, _
    ByRef lpv As Any) As Long

Declare Function lstrlen Lib "kernel32" Alias "lstrlenW" ( _
    ByRef strString As Any _
) As LongType OSVERSIONINFO
  dwOSVersionInfoSize As Long
  dwMajorVersion As Long
  dwMinorVersion As Long
  dwBuildNumber As Long
  dwPlatformId As Long
  szCSDVersion(127) As Byte
End TypePublic Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" ( _
    ByRef VersionInfo As OSVERSIONINFO _
) As LongDeclare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
    ByRef Destination As Any, _
    ByRef Source As Any, _
    ByVal Length As Long _
)
Public Function ReverseConversionNew(strSource As String) As String    Dim bySource() As Byte

    Dim i As Integer
    Dim arrKeyLayout() As Long
    Dim strIME As String

    Dim hIMC As Long
    Dim hKL As Long
    Dim lngSize As Long
    Dim lngOffset As Long
    Dim iKeyLayoutCount As Integer    Dim byCandiateArray() As Byte
    Dim CandiateList As CANDIDATELIST    Dim byWork() As Byte
    Dim lngResult As Long

    Const BUFFERSIZE As Integer = 255
    Dim osvi As OSVERSIONINFO    Dim isChineseIme As Boolean

    If strSource = "" Then Exit Function    'OS判別
    osvi.dwOSVersionInfoSize = Len(osvi)
    lngResult = GetVersionEx(osvi)    If osvi.dwPlatformId = VER_PLATFORM_WIN32_NT Then
        'WindowsNT系:Unicode字符集
        bySource = strSource        ReDim Preserve bySource(UBound(bySource) + 2)
    Else
        'Windows95系
        bySource = StrConv(strSource, vbFromUnicode)        ReDim Preserve bySource(UBound(bySource) + 1)
    End If

        hIMC = ImmGetContext(Form1.hWnd)    ReDim arrKeyLayout(BUFFERSIZE) As Long
    strIME = Space(BUFFERSIZE)
    iKeyLayoutCount = GetKeyboardLayoutList(BUFFERSIZE, arrKeyLayout(0))    isChineseIme = False
    For i = 0 To iKeyLayoutCount - 1
        If ImmEscape(arrKeyLayout(i), hIMC, IME_ESC_IME_NAME, ByVal strIME) Then
            If Trim(UCase("微软拼音输入法")) = UCase(Replace(Trim(strIME), Chr(0), "")) Then
                isChineseIme = True
                Exit For
            End If
        End If
    Next i

    If isChineseIme = False Then Exit Function

    hKL = arrKeyLayout(i)
'    hKL = GetKeyboardLayout(0)    lngSize = ImmGetConversionList(hKL, hIMC, bySource(0), Null, 0, GCL_REVERSECONVERSION)    If lngSize > 0 Then        ReDim byCandiateArray(lngSize)        lngSize = ImmGetConversionList(hKL, hIMC, bySource(0), byCandiateArray(0), lngSize, _
                                       GCL_REVERSECONVERSION)        MoveMemory CandiateList, byCandiateArray(0), Len(CandiateList)        If CandiateList.dwCount > 0 Then            lngOffset = CandiateList.dwOffset(0)            ReverseConversionNew = MidB(byCandiateArray, lngOffset + 1, _
                                     lstrlen(byCandiateArray(lngOffset)) * 2)        End If    End If    lngResult = ImmReleaseContext(Form1.hWnd, hIMC)End Function

http://www.ccrun.com/doc/go.asp?id=590

这个问题太简单了！
　　只要你有安装Win98就有一个输入法反查，比如说先得到五笔输入法中的单字的码，然后在陈桥输入法中一个含有40000个词组的文件，然后通过五笔的编码规则，通过编程自动完成40000个词组的五笔编码。
　　其实不管是什么输入法，只要你得到最基础的输入码就可以按照它的编码规则得出其他的词组。

to ch21st(风尘鸟.shannon)
谢谢你的共享精神！

到www.onlinedown.net 下载 SuperRuntimeLibrary3.0.405，他可以给出区位，五笔，平音的编码，而且可以反查。

调试易

》》》》》已经等了30天的问题：如何通过输入法（用api）反查汉字编码？？？

解决方案 »