Skip to content

Instantly share code, notes, and snippets.

@Lovesan
Last active March 7, 2020 01:57
Show Gist options
  • Save Lovesan/843a5daf6ff1564668c51f2a3886c8ea to your computer and use it in GitHub Desktop.
Save Lovesan/843a5daf6ff1564668c51f2a3886c8ea to your computer and use it in GitHub Desktop.
usage of bike and cffi libraries for instantiation of active COM objects
(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"))))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment