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