usage of bike and cffi libraries for instantiation of active COM objects

get-active-object.lisp

(eval-when (:compile-toplevel :load-toplevel :execute)

  (cffi:define-foreign-library oleaut32
    (t "oleaut32.dll"))

  (cffi:use-foreign-library oleaut32))

(cffi:defcfun ("GetActiveObject"
               %get-active-object
               :library oleaut32
               :convention :stdcall)
    :int32
  (refclsid :pointer)
  (reserved :pointer)
  (ppUnk :pointer))

(defun get-active-object (id)
  "Retrieves an active COM object for the specified class ID, which
 represents either a System.Guid object, GUID string or ProgID string."
  (declare (type (or bike:dotnet-object string) id))
  (let (guid)
    ;; Parse GUID/ProgID
    (cond
      ((stringp id)
       (unless (setf guid (ignore-errors (bike:invoke 'System.Guid 'Parse id)))
         (setf guid (bike:property (bike:invoke 'System.Type 'GetTypeFromProgID id t) 'GUID))))
      ((bike:bike-equals (bike:bike-type-of id) (bike:resolve-type 'System.GUID))
       (setf guid id)))
    (unless guid (error "Invalid COM Class ID: ~s" id))
    ;; Convert System.Guid into byte array and fill foreign memory block with its contents
    (let* ((bytes (bike:invoke guid 'ToByteArray))
           (bytes-len (bike:property bytes 'Length)))
      (cffi:with-foreign-objects ((pguid :uint8 bytes-len)
                                  (pp :pointer))
        (dotimes (i bytes-len)
          (setf (cffi:mem-aref pguid :uint8 i) (bike:dnvref bytes i)))
        ;; Call the actual Win32 function, check for return value and create .Net CCW from resulting IUnknown*
        (let ((hr (%get-active-object pguid (cffi:null-pointer) pp)))
          (when (< hr 0)
            (bike:invoke 'System.Runtime.InteropServices.Marshal 'ThrowExceptionForHR hr))
          (let ((p (cffi:mem-ref pp :pointer)))
            (prog1 (bike:invoke 'System.Runtime.InteropServices.Marshal 'GetObjectForIUnknown p)
              (bike:invoke 'System.Runtime.InteropServices.Marshal 'Release p))))))))

;; The below is required to overcome internal bike optimizations related to property retrieval,
;;  which utilize Type.GetProperty internally, which does not work for COM objects.
;; Note that you should also use bike:reflection-invoke instead of invoke, for the same reasons.

(defun comprop (obj property)
  "Retrieves a value of COM object PROPERTY"
  (declare (type bike:dotnet-object obj)
           (type alexandria:string-designator property))
  (let ((type (bike:bike-type-of obj)))
    (bike:invoke type 'InvokeMember
                 (string property)
                 (bike:enum 'System.Reflection.BindingFlags 'GetProperty)
                 nil
                 obj
                 nil)))

(defun (setf comprop) (new-value obj property)
  "Modifies a value of COM object PROPERTY"
  (declare (type bike:dotnet-object obj)
           (type alexandria:string-designator property))
  (let ((type (bike:bike-type-of obj)))
    (bike:invoke type 'InvokeMember
                 (string property)
                 (bike:enum 'System.Reflection.BindingFlags 'SetProperty)
                 nil
                 obj
                 (bike:list-to-bike-vector (list new-value)))))


;; Example:
;;
;; (defparameter *workbook*
;;   (bike:reflection-invoke (comprop (get-active-object "Excel.Application") 'Workbooks)
;;                           'Open
;;                           "C:/Dev/foo.xlsx"))))