愚者の経験

「また今度」はほとんどこない

カテゴリーアーカイブ: MVC

Accessで漢字からふりがなを取得する

「VBA ふりがな取得」でぐぐってみたら大体
「Excelを参照設定してWorkSheetFunctionのGetPhoneticを使う」
以外に方法がないような感じです。

ですがAccessで、出来れば参照設定無しで使いたいのでいろいろ調べた結果
「IFELanguageオブジェクト」というものにたどり着きました。

これを操作して漢字からふりがなを取得するモジュールを公開します。
ソースは以下になります。

Option Compare Database
Option Explicit

Private Type GUID
     Data1 As Long
     Data2 As Integer
     Data3 As Integer
     Data4(0 To 7) As Byte
End Type

Private Type TinyMORRSLT
     dwSize As Long
     pwchOutput As Long
     cchOutput As Integer
End Type

'メモリ関連API
Private Declare Sub MoveMemory Lib "kernel32" _
                Alias "RtlMoveMemory" ( _
                ByRef Destination As Any, _
                ByRef Source As Any, _
                ByVal Length As Long)

'Com関連API
Private Declare Function CoCreateInstance Lib "ole32" ( _
                ByRef rclsid As GUID, _
                ByVal pUnkOuter As Long, _
                ByVal dwClsContext As Long, _
                ByRef riid As GUID, _
                ByRef ppv As Long) As Long
Private Declare Function DispCallFunc Lib "oleaut32" ( _
                ByVal pvInstance As Long, _
                ByVal oVft As Long, _
                ByVal cc As Long, _
                ByVal vtReturn As Integer, _
                ByVal cActuals As Long, _
                ByRef prgvt As Integer, _
                ByRef prgpvarg As Long, _
                ByRef pvargResult As Variant) As Long
Private Declare Sub CoTaskMemFree Lib "ole32" ( _
                ByVal pv As Long)
Private Declare Function CLSIDFromString Lib "ole32" ( _
                ByVal OleStringCLSID As Long, _
                ByRef cGUID As Any) As Long

Private Const CLSID_MSIMEJAPAN As String = "{EB144E8A-AF48-478B-8885-641A0BD2F56A}"
Private Const IID_IFELANGUAGE As String = "{019F7152-E6DB-11d0-83C3-00C04FDDB82E}"

Private Const FELANG_REQ_CONV = &H10000
Private Const FELANG_REQ_RECONV = &H20000
Private Const FELANG_REQ_REV = &H30000

'変換モード定数
Private Const FELANG_CMODE_MONORUBY = &H2
Private Const FELANG_CMODE_NOPRUNING = &H4
Private Const FELANG_CMODE_KATAKANAOUT = &H8
Private Const FELANG_CMODE_HIRAGANAOUT = &H0
Private Const FELANG_CMODE_HALFWIDTHOUT = &H10
Private Const FELANG_CMODE_FULLWIDTHOUT = &H20
Private Const FELANG_CMODE_BOPOMOFO = &H40
Private Const FELANG_CMODE_HANGUL = &H80
Private Const FELANG_CMODE_PINYIN = &H100
Private Const FELANG_CMODE_PRECONV = &H200
Private Const FELANG_CMODE_RADICAL = &H400
Private Const FELANG_CMODE_UNKNOWNREADING = &H800
Private Const FELANG_CMODE_MERGECAND = &H1000
Private Const FELANG_CMODE_ROMAN = &H2000
Private Const FELANG_CMODE_BESTFIRST = &H4000
Private Const FELANG_CMODE_USENOREVWORDS = &H8000
Private Const FELANG_CMODE_NONE = &H1000000
Private Const FELANG_CMODE_PLAURALCLAUSE = &H2000000
Private Const FELANG_CMODE_SINGLECONVERT = &H4000000
Private Const FELANG_CMODE_AUTOMATIC = &H8000000
Private Const FELANG_CMODE_PHRASEPREDICT = &H10000000
Private Const FELANG_CMODE_CONVERSATION = &H20000000
Private Const FELANG_CMODE_NAME = FELANG_CMODE_PHRASEPREDICT
Private Const FELANG_CMODE_NOINVISIBLECHAR = &H40000000

'ふりがな取得関数
Public Function Phonetic(ByVal Value As String) As String
    Dim ret As Variant
    Dim MSIME_GUID As GUID
    Dim IFELanguage_GUID As GUID
    Dim lpIFE As Long

    'MSIME.JAPANのCLSIDをGUID型にセット
    CLSIDFromString StrPtr(CLSID_MSIMEJAPAN), MSIME_GUID
    'IFELanguageのIIDをGUID型にセット
    CLSIDFromString StrPtr(IID_IFELANGUAGE), IFELanguage_GUID

    'CLSIDとIIDからIFELanguageオブジェクト作成
    If (CoCreateInstance(MSIME_GUID, 0, 1, IFELanguage_GUID, lpIFE) <> 0) Then
        Err.Raise 500, "Phonetic", "オブジェクトの作成に失敗しました。"
    End If

    'IUnknownインターフェイスのAddRefメソッド
    DispCallFunc lpIFE, 4, 4, vbLong, 0, 0, 0, ret
    'IFELanguageのOpenメソッド
    DispCallFunc lpIFE, 12, 4, vbLong, 0, 0, 0, ret

    Dim pArgs(0 To 5) As Long
    Dim vt(0 To 5) As Integer
    Dim Args(0 To 5) As Long
    Dim ResultPtr As Long
    Dim TinyM As TinyMORRSLT
    Dim buff() As Byte
    Dim i As Integer

    'GetMorphResultの引数準備(dwRequest,dwCMode,cwchInput,pwchInput,pfCInfo,ppResult)
    'dwRequest変換方法(逆変換)
    Args(0) = FELANG_REQ_REV
    'dwCMode変換モード
    Args(1) = FELANG_CMODE_SINGLECONVERT Xor FELANG_CMODE_HALFWIDTHOUT
    'cwchInput文字列長
    Args(2) = Len(Value)
    'pwchInput文字列のメモリポインタ
    Args(3) = StrPtr(Value)
    'pfCInfo???
    Args(4) = 0
    'ppResult結果のメモリポインタ
    Args(5) = VarPtr(ResultPtr)

    For i = 0 To 5
        vt(i) = vbLong
        pArgs(i) = VarPtr(Args(i)) - 8
    Next

    'IFELanguageのGetMorphResultメソッド
    DispCallFunc lpIFE, 20, 4, vbLong, 6, vt(0), pArgs(0), ret

    'アドレスから結果を取得
    MoveMemory TinyM, ByVal ResultPtr, Len(TinyM)
    If (TinyM.cchOutput > 0) Then
        '文字列バッファのリサイズ
        ReDim buff(0 To TinyM.cchOutput * 2 - 1)

        'よみ取得
        MoveMemory buff(0), ByVal TinyM.pwchOutput, TinyM.cchOutput * 2

        'バイト配列文字列をString変換
        Phonetic = buff
    End If

    'メモリ解放
    CoTaskMemFree ResultPtr
    'IUnknownインターフェイスのReleaseメソッド
    DispCallFunc lpIFE, 8, 4, vbLong, 0, 0, 0, ret
    'IFELanguageのCloseメソッド
    DispCallFunc lpIFE, 16, 4, vbLong, 0, 0, 0, ret

End Function

使うときは「Phonetic(“ふりがな取得”)」のように使います。

なお、コメントは私の予想が多分に含まれていますのであまりアテになりません。
IFELanguageオブジェクトを連続で使うときは、毎回Closeしないほうがいいですね。

広告