'----- RegIEContextMenu -----
'IE の標準コンテキストメニューに項目を追加します。
'
'引数 strItemName
'   新たに作成する項目の名前を指定します。lngContextValue で指定した
'   条件で IE を右クリックした場合、ここで指定した文字列がメニューに
'   表示されます。アルファベットの前に "&"(アンパサンド) を
'   記述すると、そのアルファベットはショートカットキーになります。
'
'   例 : "&Google で検索"
'        "選択URLを開く(&D)"
'
'引数 strScriptFile
'   strItemName のメニューアイテムが選択されたときに実行する、
'   スクリプトファイルをフルパスで指定します。
'
'引数 lngContextValue
'   strItemName のメニューアイテムが表示される条件を指定します。
'   設定する値の詳細は CONTEXT_MENU 定数をご覧下さい。
'   複数の条件で表示したい場合は、各々の値の論理和(Or)を指定します。
'
'   例 : デフォルト動作とテキスト選択の時にメニュー項目を表示
'        CONTEXT_MENU_DEFAULT Or CONTEXT_MENU_TEXTSELECT
'
'戻り値
'   成功した場合は True が返ります。失敗した場合は False が返ります。
'
Public Function RegIEContextMenu _
    (ByRef strItemName As String, _
     ByRef strScriptFile As String, _
     ByVal lngContextValue As Long, _
     Optional ByVal lngFlags As Long) As Boolean

 Dim lngOpenExtKey As Long  'MenuExt キーのハンドルを格納
 Dim lngOpenItemKey As Long '作成されたキーのハンドルを格納
 Dim lngRet As Long
 Dim saBuffer As SECURITY_ATTRIBUTES

    'キー名が指定されていない、スクリプトファイルが存在しない場合、関数を抜ける
    If Len(strItemName) = 0 Then Exit Function
    If Len(Dir$(strScriptFile)) = 0 Then Exit Function

    'MenuExt キーをオープン。存在しない場合は作成される
    If RegCreateKeyEx(HKEY_CURRENT_USER, _
                      IE_KEY_MENUEXT, _
                      0, _
                      0, _
                      REG_OPTION_NON_VOLATILE, _
                      KEY_ALL_ACCESS, _
                      saBuffer, _
                      lngOpenExtKey, _
                      lngRet) <> ERROR_SUCCESS Then Exit Function

    'strItemName で指定された名前のキーを作成
    If RegCreateKeyEx(lngOpenExtKey, _
                      strItemName, _
                      0, _
                      0, _
                      REG_OPTION_NON_VOLATILE, _
                      KEY_ALL_ACCESS, _
                      saBuffer, _
                      lngOpenItemKey, _
                      lngRet) <> ERROR_SUCCESS Then
        GoTo CloseExtKey
    End If

    '作成したキーの "(標準)" の値に strScriptFile を設定
    If RegSetValueEx(lngOpenItemKey, _
                     vbNullString, _
                     0, _
                     REG_SZ, _
                     ByVal strScriptFile, _
                     LenB(StrConv(strScriptFile, vbFromUnicode)) + 1) <> ERROR_SUCCESS Then
        GoTo CloseItemKey
    End If
    
    '作成したキーの "contexts" の値に lngContextValue を設定
    If RegSetValueEx(lngOpenItemKey, _
                     "contexts", _
                     0, _
                     REG_DWORD, _
                     lngContextValue, _
                     LenB(lngContextValue)) <> ERROR_SUCCESS Then
        GoTo CloseItemKey
    End If
    
    'lngFlags オプションが設定されている場合
    If lngFlags Then
        '作成したキーの "Flags" の値に lngFlags を設定
        If RegSetValueEx(lngOpenItemKey, _
                         "Flags", _
                         0, _
                         REG_DWORD, _
                         lngFlags, _
                         LenB(lngFlags)) <> ERROR_SUCCESS Then
            GoTo CloseItemKey
        End If
    End If
    
    RegIEContextMenu = True
    
CloseItemKey:
    Call RegCloseKey(lngOpenItemKey)    '作成したキーを閉じる

CloseExtKey:
    Call RegCloseKey(lngOpenExtKey)     'MenuExt キーを閉じる

End Function