HSP3だけでCOMインターフェースを実装してみる

HSP3

COM のオブジェクトはクラスなど使わなくても、QueryInterface などの各メソッドへのアドレスを列挙した配列 (仮想関数テーブル) と、それへのアドレスを適切にメモリに配置するだけで成り立ちます。

HSP3 にはクラスや構造体を実装する機能はありませんが、コールバック用の関数アドレスを生成するプラグインとメモリ操作命令があります。これらを活用することで HSP3 でも COM インターフェースの実装ができます。

その実証のためにエクスプローラー ビューである IExplorerBrowser のコールバック インターフェース IExplorerBrowserEvents を実装してみました。IExplorerBrowser はビューが生成されたりナビゲーションが発生した場合に IExplorerBrowserEvents の対応するメソッドを呼び出します。

今回のサンプルではフォルダーなどをクリックしてナビゲーションを発生させるとタイトルバーに情報が表示されるようにしています。それとなぜかフォルダーをダブルクリックすると別窓が開いてしまうのでコンテキスト メニューから 2 番目の 開く コマンドを選択する必要があります。

コード

※hscallbk が必要

#include "hscallbk.as"

#define NULL 0
#define S_OK 0
#define E_INVALIDARG 0x80070057
#define E_NOINTERFACE 0x80004002

#define CLSCTX_INPROC_SERVER 1

#define FVM_AUTO -1
#define FVM_FIRST 1
#define FVM_ICON 1
#define FVM_SMALLICON 2
#define FVM_LIST 3
#define FVM_DETAILS 4
#define FVM_THUMBNAIL 5
#define FVM_TILE 6
#define FVM_THUMBSTRIP 7
#define FVM_CONTENT 8
#define FVM_LAST 8

#define FWF_FULLROWSELECT 0x200000

#define SBSP_DEFBROWSER         0x0000
#define SBSP_SAMEBROWSER        0x0001
#define SBSP_NEWBROWSER         0x0002
#define SBSP_DEFMODE            0x0000
#define SBSP_OPENMODE           0x0010
#define SBSP_EXPLOREMODE        0x0020
#define SBSP_HELPMODE           0x0040
#define SBSP_NOTRANSFERHIST     0x0080
#define SBSP_ABSOLUTE           0x0000
#define SBSP_RELATIVE           0x1000
#define SBSP_PARENT             0x2000
#define SBSP_NAVIGATEBACK       0x4000
#define SBSP_NAVIGATEFORWARD    0x8000

#define SHGFI_DISPLAYNAME 0x000000200
#define SHGFI_PIDL 0x000000008

#uselib "msvcrt"
#cfunc malloc "malloc" int
#func free "free" int
#cfunc memcmp "memcmp" int, int, int

#uselib "kernel32"
#func InterlockedIncrement "InterlockedIncrement" int
#func InterlockedDecrement "InterlockedDecrement" int

#uselib "shell32"
#func SHGetFileInfoA "SHGetFileInfoA" int, int, int, int, int
#func SHParseDisplayName "SHParseDisplayName" wptr, int, int, int, int

#uselib "ole32"
#func CLSIDFromString "CLSIDFromString" wptr, int
#func CoCreateInstance "CoCreateInstance" int, int, int, int, int
#func CoTaskMemFree "CoTaskMemFree" int

// IExplorerBrowserEvents 用の仮想関数テーブルを作る
#uselib ""
#func IExplorerBrowserEvents_QueryInterface "" int, int, int
setcallbk CExplorerBrowserEvents_QueryInterface, IExplorerBrowserEvents_QueryInterface, *FnCExplorerBrowserEvents_QueryInterface
#func IExplorerBrowserEvents_AddRef "" int
setcallbk CExplorerBrowserEvents_AddRef, IExplorerBrowserEvents_AddRef, *FnCExplorerBrowserEvents_AddRef
#func IExplorerBrowserEvents_Release "" int
setcallbk CExplorerBrowserEvents_Release, IExplorerBrowserEvents_Release, *FnCExplorerBrowserEvents_Release
#func IExplorerBrowserEvents_OnNavigationPending "" int, int
setcallbk CExplorerBrowserEvents_OnNavigationPending, IExplorerBrowserEvents_OnNavigationPending, *FnCExplorerBrowserEvents_OnNavigationPending
#func IExplorerBrowserEvents_OnViewCreated "" int, int
setcallbk CExplorerBrowserEvents_OnViewCreated, IExplorerBrowserEvents_OnViewCreated, *FnCExplorerBrowserEvents_OnViewCreated
#func IExplorerBrowserEvents_OnNavigationComplete "" int, int
setcallbk CExplorerBrowserEvents_OnNavigationComplete, IExplorerBrowserEvents_OnNavigationComplete, *FnCExplorerBrowserEvents_OnNavigationComplete
#func IExplorerBrowserEvents_OnNavigationFailed "" int, int
setcallbk CExplorerBrowserEvents_OnNavigationFailed, IExplorerBrowserEvents_OnNavigationFailed, *FnCExplorerBrowserEvents_OnNavigationFailed

dim CExplorerBrowserEventsVtbl, 7
CExplorerBrowserEventsVtbl(0) = varptr(CExplorerBrowserEvents_QueryInterface)
CExplorerBrowserEventsVtbl(1) = varptr(CExplorerBrowserEvents_AddRef)
CExplorerBrowserEventsVtbl(2) = varptr(CExplorerBrowserEvents_Release)
CExplorerBrowserEventsVtbl(3) = varptr(CExplorerBrowserEvents_OnNavigationPending)
CExplorerBrowserEventsVtbl(4) = varptr(CExplorerBrowserEvents_OnViewCreated)
CExplorerBrowserEventsVtbl(5) = varptr(CExplorerBrowserEvents_OnNavigationComplete)
CExplorerBrowserEventsVtbl(6) = varptr(CExplorerBrowserEvents_OnNavigationFailed)

/*
CExplorerBrowserEvents メモリ レイアウト

0 4 void* CExplorerBrowserEventsVtbl
4 4 ULONG m_refCount
8 4 DWORD m_cookie
*/
#define SizeOfCExplorerBrowserEvents 12
#define CExplorerBrowserEvents_Vtbl 0
#define CExplorerBrowserEvents_RefCount 4
#define CExplorerBrowserEvents_Cookie 8

#module
// オブジェクトとメソッド番号からメソッドの関数アドレスを取得する便利関数
#defcfunc getMethodAddr int pObj, int index
    dupptr _pObjVtbl, pObj, 4, 4
    dupptr _pMethod, _pObjVtbl + 4 * index, 4, 4
    return _pMethod
#global

// 文字列から GUID 構造体に変換
dim CLSID_ExplorerBrowser, 4
CLSIDFromString "{71f96385-ddd6-48d3-a0c1-ae06e8b055fb}", varptr(CLSID_ExplorerBrowser)

dim IID_IUnknown, 4
CLSIDFromString "{00000000-0000-0000-C000-000000000046}", varptr(IID_IUnknown)

dim IID_IExplorerBrowser, 4
CLSIDFromString "{dfd3b6b5-c10c-4be9-85f6-a66969f402f6}", varptr(IID_IExplorerBrowser)

dim IID_IExplorerBrowserEvents, 4
CLSIDFromString "{361bbdc7-e6ee-4e13-be58-58e2240c810f}", varptr(IID_IExplorerBrowserEvents)

// エクスプローラー ブラウザーを作成
pExplorerBrowser = 0
hr = CoCreateInstance(varptr(CLSID_ExplorerBrowser), NULL, CLSCTX_INPROC_SERVER, varptr(IID_IExplorerBrowser), varptr(pExplorerBrowser))
if (pExplorerBrowser == 0) {
    mes "pExplorerBrowser is null"
    stop
}

// ブラウザー初期化
rect = 0, 26, ginfo_winx, ginfo_winy
fs = FVM_DETAILS, FWF_FULLROWSELECT
prms = pExplorerBrowser, hwnd, varptr(rect), varptr(fs)
hr = callfunc(prms, getMethodAddr(pExplorerBrowser, 3) /* IExplorerBrowser_Initialize */, length(prms))

// コールバック登録
pExplorerBrowserEvents = NewCExplorerBrowserEvents()
prms = pExplorerBrowser, pExplorerBrowserEvents, pExplorerBrowserEvents + CExplorerBrowserEvents_Cookie
hr = callfunc(prms, getMethodAddr(pExplorerBrowser, 9) /* IExplorerBrowser_Advise */, length(prms))

// フォルダーへ移動
pIdList = 0
SHParseDisplayName "C:\\", NULL, varptr(pIdList), 0, NULL // ファイル パスから IDLIST へ変換
prms = pExplorerBrowser, pIdList, SBSP_DEFBROWSER
hr = callfunc(prms, getMethodAddr(pExplorerBrowser, 13) /* IExplorerBrowser_BrowseToIDList */, length(prms))
CoTaskMemFree pIdList
pIdList = 0

objsize 50, 26
pos 0, 0: button gosub "戻る", *goBack
pos 50, 0: button gosub "進む", *goForward
pos 100, 0: button gosub "上へ", *goParent

onexit *exit
stop

*goBack
    prms = pExplorerBrowser, NULL, SBSP_NAVIGATEBACK
    hr = callfunc(prms, getMethodAddr(pExplorerBrowser, 13) /* IExplorerBrowser_BrowseToIDList */, length(prms))
    return
    
*goForward
    prms = pExplorerBrowser, NULL, SBSP_NAVIGATEFORWARD
    hr = callfunc(prms, getMethodAddr(pExplorerBrowser, 13) /* IExplorerBrowser_BrowseToIDList */, length(prms))
    return
    
*goParent
    prms = pExplorerBrowser, NULL, SBSP_PARENT
    hr = callfunc(prms, getMethodAddr(pExplorerBrowser, 13) /* IExplorerBrowser_BrowseToIDList */, length(prms))
    return
    
*exit
    if (pExplorerBrowser) {
        prms = pExplorerBrowser
        hr = callfunc(prms, getMethodAddr(pExplorerBrowser, 4) /* IExplorerBrowser_Destroy */, length(prms))
    
        prms = pExplorerBrowser
        hr = callfunc(prms, getMethodAddr(pExplorerBrowser, 2) /* IExplorerBrowser_Release */, length(prms))
        
        pExplorerBrowser = 0
    }
    end

// -----------------------------------------
// CExplorerBrowserEvents メンバー関数の実装
// -----------------------------------------
*FnCExplorerBrowserEvents_QueryInterface
    // params: This, riid, ppvObject
    if (callbkarg(2) == 0) { // ppvObject が NULL
        return E_INVALIDARG
    }
    
    dupptr pvObject, callbkarg(2), 4, 4
    pvObject = 0

    // IID_IUnknown か IID_IExplorerBrowserEvents ならインターフェース変換可能
    if (memcmp(varptr(IID_IUnknown), callbkarg(1), 4) == 0 || memcmp(varptr(IID_IExplorerBrowserEvents), callbkarg(1), 4) == 0) {
        pvObject = callbkarg(0)
        prms = callbkarg(0)
        hr = callfunc(prms, getMethodAddr(callbkarg(0), 1) /* IExplorerBrowserEvents_AddRef */, length(prms))
        return S_OK
    }
    return E_NOINTERFACE
    
*FnCExplorerBrowserEvents_AddRef
    // params: This
    return InterlockedIncrement(callbkarg(0) + CExplorerBrowserEvents_RefCount)
    
*FnCExplorerBrowserEvents_Release
    // params: This
    ref = InterlockedDecrement(callbkarg(0) + CExplorerBrowserEvents_RefCount)
    if (ret == 0) {
        // CExplorerBrowserEvents クラスを破棄
        free callbkarg(0)
        return 0
    }
    return ref
    
*FnCExplorerBrowserEvents_OnNavigationPending
    // params: This, pidlFolder

    title "ナビゲーション中..."
    return S_OK
    
*FnCExplorerBrowserEvents_OnViewCreated
    // params: This, psv
    return S_OK
    
*FnCExplorerBrowserEvents_OnNavigationComplete
    // params: This, pidlFolder

    // 現在のフォルダー名をタイトルバーに表示させてみる
    sdim fi, 360 // SHFILEINFOA
    if (SHGetFileInfoA(callbkarg(1), 0, varptr(fi), 360, SHGFI_DISPLAYNAME | SHGFI_PIDL)) {
        sdim szDisplayName
        getstr szDisplayName, fi, 12, '0', 260
        title "成功: " + szDisplayName
    }
    return S_OK
    
*FnCExplorerBrowserEvents_OnNavigationFailed
    // params: This, pidlFolder
    
    title "失敗"
    return S_OK

#defcfunc NewCExplorerBrowserEvents
    // CExplorerBrowserEvents クラスを構築
    pObj = malloc(SizeOfCExplorerBrowserEvents)
    dupptr _obj, pObj, SizeOfCExplorerBrowserEvents, 4
    _obj(0) = varptr(CExplorerBrowserEventsVtbl) // CExplorerBrowserEventsVtbl
    _obj(1) = 1 // m_refCount
    _obj(2) = 0 // m_cookie
return pObj