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
#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)
#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
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) , length(prms))
pExplorerBrowserEvents = NewCExplorerBrowserEvents()
prms = pExplorerBrowser, pExplorerBrowserEvents, pExplorerBrowserEvents + CExplorerBrowserEvents_Cookie
hr = callfunc(prms, getMethodAddr(pExplorerBrowser, 9) , length(prms))
pIdList = 0
SHParseDisplayName "C:\\", NULL, varptr(pIdList), 0, NULL
prms = pExplorerBrowser, pIdList, SBSP_DEFBROWSER
hr = callfunc(prms, getMethodAddr(pExplorerBrowser, 13) , 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) , length(prms))
return
*goForward
prms = pExplorerBrowser, NULL, SBSP_NAVIGATEFORWARD
hr = callfunc(prms, getMethodAddr(pExplorerBrowser, 13) , length(prms))
return
*goParent
prms = pExplorerBrowser, NULL, SBSP_PARENT
hr = callfunc(prms, getMethodAddr(pExplorerBrowser, 13) , length(prms))
return
*exit
if (pExplorerBrowser) {
prms = pExplorerBrowser
hr = callfunc(prms, getMethodAddr(pExplorerBrowser, 4) , length(prms))
prms = pExplorerBrowser
hr = callfunc(prms, getMethodAddr(pExplorerBrowser, 2) , length(prms))
pExplorerBrowser = 0
}
end
*FnCExplorerBrowserEvents_QueryInterface
if (callbkarg(2) == 0) {
return E_INVALIDARG
}
dupptr pvObject, callbkarg(2), 4, 4
pvObject = 0
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) , length(prms))
return S_OK
}
return E_NOINTERFACE
*FnCExplorerBrowserEvents_AddRef
return InterlockedIncrement(callbkarg(0) + CExplorerBrowserEvents_RefCount)
*FnCExplorerBrowserEvents_Release
ref = InterlockedDecrement(callbkarg(0) + CExplorerBrowserEvents_RefCount)
if (ret == 0) {
free callbkarg(0)
return 0
}
return ref
*FnCExplorerBrowserEvents_OnNavigationPending
title "ナビゲーション中..."
return S_OK
*FnCExplorerBrowserEvents_OnViewCreated
return S_OK
*FnCExplorerBrowserEvents_OnNavigationComplete
sdim fi, 360
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
title "失敗"
return S_OK
#defcfunc NewCExplorerBrowserEvents
pObj = malloc(SizeOfCExplorerBrowserEvents)
dupptr _obj, pObj, SizeOfCExplorerBrowserEvents, 4
_obj(0) = varptr(CExplorerBrowserEventsVtbl)
_obj(1) = 1
_obj(2) = 0
return pObj
