1#lang scribble/doc
2@(require scribble/manual
3          "com-common.rkt"
4          scribble/racket
5          (for-syntax racket/base)
6          (for-label racket/base
7                     (except-in racket/contract ->)
8                     ffi/unsafe
9                     ffi/unsafe/com
10                     ffi/unsafe/alloc
11                     ffi/winapi))
12
13@title[#:tag "com-intf"]{COM Classes and Interfaces}
14
15@defmodule[ffi/unsafe/com]{The @racketmodname[ffi/unsafe/com] library
16exports all of @racketmodname[ffi/com], and it also supports direct,
17FFI-based calls to COM object methods.}
18
19@; ----------------------------------------
20
21@section{Describing COM Interfaces}
22
23@defform/subs[(define-com-interface (_id _super-id)
24                ([method-id ctype-expr maybe-alloc-spec] ...))
25              ([maybe-alloc-spec code:blank
26                                 (code:line #:release-with-function function-id)
27                                 (code:line #:release-with-method method-id)
28                                 #:releases])]{
29
30Defines @racket[_id] as an interface that extends @racket[_super-id],
31where @racket[_super-id] is often @racket[_IUnknown], and that
32includes methods named by @racket[method-id]. The @racket[_id] and
33@racket[_super-id] identifiers must start with an underscore. A
34@racket[@#,racket[_super-id]@#,racketidfont{_vt}] must also be defined
35for deriving a virtual-method table type.
36
37The order of the @racket[method-id]s must match the specification of
38the @tech{COM interface}, not including methods inherited from
39@racket[_super-id]. Each method type produced by @racket[ctype-expr]
40that is not @racket[_fpointer] must be a function type whose first
41argument is the ``self'' pointer, usually constructed with
42@racket[_mfun] or @racket[_hmfun].
43
44The @racket[define-com-interface] form binds @racket[_id],
45@racket[@#,racketvarfont{id}?], @racket[@#,racket[_id]-pointer],
46@racket[@#,racket[_id]@#,racketidfont{_}vt] (for the virtual-method
47table), @racket[@#,racket[_id]@#,racketidfont{_}vt-pointer], and
48@racket[method-id] for each method whose @racket[ctype-expr] is not
49@racket[_fpointer]. (In other words, use @racket[_fpointer] as a
50placeholder for methods of the interface that you do not need to
51call.) An instance of the interface will have type
52@racket[@#,racket[_id]-pointer]. Each defined @racket[method-id] is
53bound to a function-like macro that expects a
54@racket[@#,racket[_id]-pointer] as its first argument and the method
55arguments as the remaining arguments.
56
57A @racket[maybe-alloc-spec] describes allocation and finalization
58information for a method along the lines of
59@racketmodname[ffi/unsafe/alloc].  If the @racket[maybe-alloc-spec] is
60@racket[#:release-with-function function-id], then
61@racket[function-id] is used to deallocate the result produced by the
62method, unless the result is explicitly deallocated before it becomes
63unreachable; for example, @racket[#:release-with-function Release] is
64suitable for a method that returns a COM interface reference that must
65be eventually released.  The @racket[#:release-with-method method-id]
66form is similar, except that the deallocator is a method on the same
67object as the allocating method (i.e., one of the other
68@racket[method-id]s or an inherited method). A @racket[#:releases]
69annotation indicates that a method is a deallocator (so that a value
70should not be automatically deallocated if it is explicitly
71deallocated using the method).
72
73See @secref["com-intf-example"] for an example using
74@racket[define-com-interface].}
75
76@; ----------------------------------------
77
78@section{Obtaining COM Interface References}
79
80@defproc[(QueryInterface [iunknown com-iunknown?] [iid iid?] [intf-pointer-type ctype?])
81         (or/c cpointer? #f)]{
82
83Attempts to extract a @tech{COM interface} pointer for the given
84@tech{COM object}. If the object does not support the requested
85interface, the result is @racket[#f], otherwise it is cast to the type
86@racket[intf-pointer-type].
87
88Specific @tech{IIDs} and @racket[intf-pointer-type]s go together. For
89example, @racket[IID_IUnknown] goes with @racket[_IUnknown-pointer].
90
91For a non-@racket[#f] result, @racket[Release] function is the
92automatic deallocator for the resulting pointer. The pointer is
93register with a deallocator after the cast to
94@racket[intf-pointer-type], which is why @racket[QueryInterface]
95accepts the @racket[intf-pointer-type] argument (since a cast
96generates a fresh reference).}
97
98@deftogether[(
99@defproc[(AddRef [iunknown com-iunknown?]) exact-positive-integer?]
100@defproc[(Release [iunknown com-iunknown?]) exact-nonnegative-integer?]
101)]{
102
103Increments or decrements the reference count on @racket[iunknown],
104returning the new reference count and releasing the interface
105reference if the count goes to zero.}
106
107
108@defproc[(make-com-object [iunknown com-iunknown?] [clsid (or/c clsid? #f)]
109                          [#:manage? manage? any/c #t])
110         com-object?]{
111
112Converts a @tech{COM object} into an object that can be used with the
113COM automation functions, such as @racket[com-invoke].
114
115If @racket[manage?] is true, the resulting object is registered with
116the current custodian and a finalizer to call @racket[com-release]
117when the custodian is shut down or when the object becomes
118inaccessible.}
119
120@; ----------------------------------------
121
122@section{COM FFI Helpers}
123
124
125@defform[(_wfun fun-option ... maybe-args type-spec ... -> type-spec
126            maybe-wrapper)]{
127
128Like @racket[_fun], but adds @racket[#:abi winapi].}
129
130
131@defform[(_mfun fun-option ... maybe-args type-spec ... -> type-spec
132            maybe-wrapper)]{
133
134Like @racket[_wfun], but adds a @racket[_pointer] type (for the
135``self'' argument of a method) as the first argument @racket[type-spec].}
136
137
138@defform[(_hfun fun-option ... type-spec ... -> id maybe-allow output-expr)
139         #:grammar
140         ([maybe-allow code:blank
141                       (code:line #:allow [result-id allow?-expr])])]{
142
143Like @racket[_wfun], but for a function that returns an
144@racket[_HRESULT]. The result is bound to @racket[result-id] if
145@racket[#:allow] is specified, otherwise the result is not directly
146accessible.
147
148The @racket[_hfun] form handles the @racket[_HRESULT] value of the
149foreign call as follows:
150
151@itemlist[
152
153 @item{If the result is zero or if @racket[#:allow] is specified and
154       @racket[allow?-expr] produces @racket[#t], then
155       @racket[output-expr] (as in a @racket[_maybe-wrapper] for
156       @racket[_fun]) determines the result.}
157
158 @item{If the result is @cpp{RPC_E_CALL_REJECTED} or
159       @cpp{RPC_E_SERVERCALL_RETRYLATER}, the call is automatically
160       retried up to @racket[(current-hfun-retry-count)] times with a
161       delay of @racket[(current-hfun-retry-delay)] seconds between
162       each attempt.}
163
164 @item{Otherwise, an error is raised using @racket[windows-error] and
165       using @racket[id] as the name of the failed function.}
166
167]
168
169@history[#:changed "6.2" @elem{Added @racket[#:allow] and automatic retries.}]}
170
171
172@defform[(_hmfun fun-option ... type-spec ... -> id output-expr)]{
173
174Like @racket[_hfun], but lke @racket[_mfun] in that @racket[_pointer]
175is added for the first argument.}
176
177@deftogether[(
178@defparam[current-hfun-retry-count exact-nonnegative-integer? count]
179@defparam[current-hfun-retry-delay secs (>=/c 0.0)]
180)]{
181
182Parameters that determine the behavior of automatic retries for @racket[_hfun].
183
184@history[#:added "6.2"]}
185
186
187@defproc[(HRESULT-retry? [r exact-nonnegative-integer?]) boolean?]{
188
189Returns @racket[#t] if @racket[r] is @cpp{RPC_E_CALL_REJECTED}
190or @cpp{RPC_E_SERVERCALL_RETRYLATER}, @racket[#f] otherwise.
191
192@history[#:added "6.2"]}
193
194
195@deftogether[(
196@defthing[_GUID ctype?]
197@defthing[_GUID-pointer ctype?]
198@defthing[_HRESULT ctype?]
199@defthing[_LCID ctype?]
200)]{
201
202Some @tech{C types} that commonly appear in COM interface
203specifications.}
204
205
206@defthing[LOCALE_SYSTEM_DEFAULT exact-integer?]{
207
208The usual value for a @racket[_LCID] argument.}
209
210
211@deftogether[(
212@defproc[(SysFreeString [str _pointer]) void?]
213@defproc[(SysAllocStringLen [content _pointer] [len integer?]) cpointer?]
214)]{
215
216COM interfaces often require or return srings that must be allocated
217or freed as system strings.
218
219When receiving a string value, @racket[cast] it to
220@racket[_string/utf-16] to extract a copy of the string, and then free
221the original pointer with @racket[SysFreeString].}
222
223
224@deftogether[(
225@defthing[IID_NULL iid?]
226@defthing[IID_IUnknown iid?]
227)]{
228
229Commonly used @tech{IIDs}.}
230
231@deftogether[(
232@defthing[_IUnknown ctype?]
233@defthing[_IUnknown-pointer ctype?]
234@defthing[_IUnknown_vt ctype?]
235)]{
236
237Types for the @cpp{IUnknown} @tech{COM interface}.}
238
239
240@defproc[(windows-error [msg string?] [hresult exact-integer?])
241         any]{
242
243Raises an exception. The @racket[msg] string provides the base error
244message, but @racket[hresult] and its human-readable interpretation
245(if available) are added to the message.}
246
247@; ----------------------------------------
248
249@section[#:tag "com-intf-example"]{COM Interface Example}
250
251Here's an example using the Standard Component Categories Manager to
252enumerate installed COM classes that are in the different
253system-defined categories. The example illustrates instantiating a
254COM class by @tech{CLSID}, describing COM interfaces with
255@racket[define-com-interface], and using allocation specifications to
256ensure that resources are reclaimed even if an error is encountered or
257the program is interrupted.
258
259@(define-syntax-rule (define-literals id ...) (begin (define-literal id) ...))
260@(define-syntax-rule (define-literal id)
261   (define-syntax id (make-element-id-transformer
262                      (lambda (stx) #'@racketidfont[(symbol->string 'id)]))))
263@define-literals[_ULONG _CATID _REFCATID
264                 _CATEGORYINFO _CATEGORYINFO-pointer
265                 _IEnumGUID _IEnumGUID-pointer
266                 _IEnumCATEGORYINFO _IEnumCATEGORYINFO-pointer
267                 _ICatInformation _ICatInformation-pointer]
268
269@racketmod[
270racket/base
271(require ffi/unsafe
272         ffi/unsafe/com)
273
274(provide show-all-classes)
275
276(code:comment @#,t{The function that uses COM interfaces defined further below:})
277
278(define (show-all-classes)
279  (define ccm
280    (com-create-instance CLSID_StdComponentCategoriesMgr))
281  (define icat (QueryInterface (com-object-get-iunknown ccm)
282                               IID_ICatInformation
283                               _ICatInformation-pointer))
284  (define eci (EnumCategories icat LOCALE_SYSTEM_DEFAULT))
285  (for ([catinfo (in-producer (lambda () (Next/ci eci)) #f)])
286    (printf "~a:\n"
287            (cast (array-ptr (CATEGORYINFO-szDescription catinfo))
288                  _pointer
289                  _string/utf-16))
290    (define eg
291      (EnumClassesOfCategories icat (CATEGORYINFO-catid catinfo)))
292    (for ([guid (in-producer (lambda () (Next/g eg)) #f)])
293      (printf " ~a\n" (or (clsid->progid guid)
294                          (guid->string guid))))
295    (Release eg))
296  (Release eci)
297  (Release icat))
298
299(code:comment @#,t{The class to instantiate:})
300
301(define CLSID_StdComponentCategoriesMgr
302  (string->clsid "{0002E005-0000-0000-C000-000000000046}"))
303
304(code:comment @#,t{Some types and variants to match the specification:})
305
306(define _ULONG _ulong)
307(define _CATID _GUID)
308(define _REFCATID _GUID-pointer)
309(define-cstruct _CATEGORYINFO ([catid _CATID]
310                               [lcid _LCID]
311                               [szDescription (_array _short 128)]))
312
313(code:comment @#,t{------ IEnumGUID -------})
314
315(define IID_IEnumGUID
316  (string->iid "{0002E000-0000-0000-C000-000000000046}"))
317
318(define-com-interface (_IEnumGUID _IUnknown)
319  ([Next/g (_mfun (_ULONG = 1) (code:comment @#,t{simplifed to just one})
320                  (guid : (_ptr o _GUID))
321                  (got : (_ptr o _ULONG))
322                  -> (r : _HRESULT)
323                  -> (cond
324                       [(zero? r) guid]
325                       [(= r 1) #f] ; done
326                       [else (windows-error "Next/g failed" r)]))]
327   [Skip _fpointer]
328   [Reset _fpointer]
329   [Clone _fpointer]))
330
331(code:comment @#,t{------ IEnumCATEGORYINFO -------})
332
333(define IID_IEnumCATEGORYINFO
334  (string->iid "{0002E011-0000-0000-C000-000000000046}"))
335
336(define-com-interface (_IEnumCATEGORYINFO _IUnknown)
337  ([Next/ci (_mfun (_ULONG = 1) (code:comment @#,t{simplifed to just one})
338                   (catinfo : (_ptr o _CATEGORYINFO))
339                   (got : (_ptr o _ULONG))
340                   -> (r : _HRESULT)
341                   -> (cond
342                       [(zero? r) catinfo]
343                       [(= r 1) #f] ; done
344                       [else (windows-error "Next/ci failed" r)]))]
345   [Skip _fpointer]
346   [Reset _fpointer]
347   [Clone _fpointer]))
348
349(code:comment @#,t{------ ICatInformation -------})
350
351(define IID_ICatInformation
352  (string->iid "{0002E013-0000-0000-C000-000000000046}"))
353
354(define-com-interface (_ICatInformation _IUnknown)
355  ([EnumCategories (_hmfun _LCID
356                           (p : (_ptr o _IEnumCATEGORYINFO-pointer))
357                           -> EnumCategories p)]
358   [GetCategoryDesc (_hmfun _REFCATID _LCID
359                            (p : (_ptr o _pointer))
360                            -> GetCategoryDesc
361                            (begin0
362                             (cast p _pointer _string/utf-16)
363                             (SysFreeString p)))]
364   [EnumClassesOfCategories (_hmfun (_ULONG = 1) (code:comment @#,t{simplifed})
365                                    _REFCATID
366                                    (_ULONG = 0) (code:comment @#,t{simplifed})
367                                    (_pointer = #f)
368                                    (p : (_ptr o
369                                               _IEnumGUID-pointer))
370                                    -> EnumClassesOfCategories p)
371                            #:release-with-function Release]
372   [IsClassOfCategories _fpointer]
373   [EnumImplCategoriesOfClass _fpointer]
374   [EnumReqCategoriesOfClass _fpointer]))
375
376]
377