通过sb-alien调用com, IDispatch接口 无从入手

闲聊灌水
1
  • 外部函数定义
HRESULT CoCreateInstance(
  [in]  REFCLSID  rclsid,
  [in]  LPUNKNOWN pUnkOuter,
  [in]  DWORD     dwClsContext,
  [in]  REFIID    riid,
  [out] LPVOID    *ppv
);

(sb-alien:define-alien-routine ("CoCreateInstance" CoCreateInstance)
  sb-alien:int
  (REFCLSID  (* GUID))
  (LPUNKNOWN sb-alien:system-area-pointer)
  (DWORD (sb-alien:unsigned 32))
  (REFIID (* GUID))
  (LPVOID sb-alien:system-area-pointer :out)
)
  • 返回值处理，result为0，外部函数调用成功
(multiple-value-bind (result ppv)
    (sb-win32ole:CoCreateInstance pclsid (sb-sys:int-sap 0) (+ #x1 #x4) REFIID)
    (let (tes)
        ;; 获取指针
        (setf tes (sb-sys:int-sap (sb-sys:sap-ref-32 ppv 0)))
        ;; 再次对指针寻址：报错！！！
        (print (sb-sys:sap-ref-32 (sb-sys:sap-ref-32 ppv 0) 0))
)
  • 错误
Unhandled memory fault at #xFAB34309.

预期ppv返回的是IDispatch接口的指针的指针之类的，测试结果感觉ppv返回的是一个对象。也不是函数指针数组。

2

经测试cl-win32ole包，在调用cffi的情况下是可以征程连接com组件的。

  • cffi中对sb-alien的调用
(defmacro %foreign-funcall-pointer (ptr args &key convention)
  "Funcall a pointer to a foreign function."
  (declare (ignore convention))
  (multiple-value-bind (types fargs rettype)
      (foreign-funcall-type-and-args args)
    (with-unique-names (function)
      `(with-alien ((,function (* (function ,rettype ,@types)) ,ptr))
         (alien-funcall ,function ,@fargs)))))
  • 我用sb-alien复刻的代码
(let* ( (IDispatch (sb-alien:sap-alien ppv sb-win32ole:IDispatch))
            (IDispatchVtbl (sb-alien:sap-alien (slot IDispatch 'sb-win32ole:vtbl) sb-win32ole:IDispatchVtbl))
            (p_GetTypeInfoCount (slot IDispatchVtbl 'sb-win32ole:GetTypeInfoCount))  
          )
        (sb-alien:with-alien (  (cc (* sb-alien:int))
                                (GetTypeInfoCount (* (function sb-alien:int (* sb-alien:int))) p_GetTypeInfoCount))
            (alien-funcall GetTypeInfoCount cc)
        ))
  • 其中ptr与p_GetTypeInfoCount可以确认 是指向相同位置的指针。

但后者还是报错了Unhandled memory fault

难道需要加载更多的dll文件？

3
  • 跑通了
(sb-alien:with-alien (  (a (* sb-alien:int) (sb-alien:make-alien sb-alien:int))
                                (GetTypeInfoCount (* (function sb-alien:int sb-alien:system-area-pointer (* sb-alien:int))) p_GetTypeInfoCount))
            (sb-alien:alien-funcall GetTypeInfoCount ppv a))

接口函数的第一个参数应该是接口的指针。

这是吃没学过C++的亏。