diff --git a/collects/ffi/unsafe/com.rkt b/collects/ffi/unsafe/com.rkt index 83bd5a8ea1..12dadee9a7 100644 --- a/collects/ffi/unsafe/com.rkt +++ b/collects/ffi/unsafe/com.rkt @@ -1251,6 +1251,7 @@ [(IUnknown? arg) 'iunknown] [(eq? com-omit arg) 'any] [(box? arg) `(box ,(arg-to-type (unbox arg)))] + [(date? arg) 'date] [else (error 'com "cannot infer marshal format for value: ~e" arg)])) (define (elem-desc-ref func-desc i) @@ -1419,11 +1420,12 @@ [wSecond _WORD] [wMilliseconds _WORD])) -(define-ole VariantTimeToSystemTime (_wfun _DATE _SYSTEMTIME-pointer +(define-oleaut VariantTimeToSystemTime (_wfun _DATE _SYSTEMTIME-pointer -> _INT)) -(define-ole SystemTimeToVariantTime (_wfun _SYSTEMTIME-pointer (d : (_ptr o _DATE)) - -> (r : _int) - -> (and (zero? r) d))) +(define-oleaut SystemTimeToVariantTime (_wfun #:save-errno 'windows + _SYSTEMTIME-pointer (d : (_ptr o _DATE)) + -> (r : _int) + -> (and (not (zero? r)) d))) (define _date (make-ctype _DATE @@ -1438,12 +1440,12 @@ (if (date*? d) (inexact->exact (floor (* (date*-nanosecond d) 1000))) 0))) - (define d (SystemTimeToVariantTime s)) - (or d - (error 'date "error converting date to COM date"))) + (or (SystemTimeToVariantTime s) + (error 'date "error converting date to COM date (~a)" + (saved-errno)))) (lambda (d) (define s (make-SYSTEMTIME 0 0 0 0 0 0 0 0)) - (unless (zero? (VariantTimeToSystemTime d s)) + (unless (not (zero? (VariantTimeToSystemTime d s))) (error 'date "error converting date from COM date")) (seconds->date (find-seconds (SYSTEMTIME-wSecond s) @@ -2072,7 +2074,18 @@ (define com-set-property! (case-lambda [(obj name val) - (do-com-invoke 'com-set-property! obj name (list val) INVOKE_PROPERTYPUT)] + (cond + [(string? name) + (do-com-invoke 'com-set-property! obj name (list val) INVOKE_PROPERTYPUT)] + [(and (list? name) + (pair? name) + (string? (car name))) + (do-com-invoke 'com-set-property! obj + (car name) (append (cdr name) (list val)) + INVOKE_PROPERTYPUT)] + [else + (raise-argument-error 'com-set-property! "(or/c string? (cons/c string? list))" + name)])] [(obj name1 name2 . names+val) (check-com-obj 'com-set-property obj) (define names (list* name1 name2 names+val)) diff --git a/collects/mysterx/scribblings/methprop.scrbl b/collects/mysterx/scribblings/methprop.scrbl index bf4311c2b2..defab1f8be 100644 --- a/collects/mysterx/scribblings/methprop.scrbl +++ b/collects/mysterx/scribblings/methprop.scrbl @@ -137,8 +137,8 @@ Like @racket[cocreate-instance-from-coclass], but using a ProgID.} Returns a list of strings indicating the names of writeable properties in @racket[obj/type].} -@defproc[(com-set-property-type [obj/type (or/c com-object? com-type?)] - [property-name strig?]) +@defproc[(com-set-property-type [obj/type (or/c com-object? com-type?)] + [property-name string?]) (listof symbol?)]{ Returns a list of symbols indicating the type of the specified @@ -146,13 +146,16 @@ Like @racket[cocreate-instance-from-coclass], but using a ProgID.} information on the symbols.} @defproc[(com-set-property! [obj com-object?] - [string? property] ...+ + [property (or/c string? + (cons/c string? list?))] ...+ [v any/c]) void?]{ Sets the value of the final property in @racket[obj] to @racket[v] by following the @racket[property]s, where the value of each - intermediate property is a COM object.} + intermediate property is a COM object. A @racket[property] + can be a list instead of a string to represent a parameterized property + and its arguments.} @defproc[(com-help [obj/type (or/c com-object? com-type?)] [topic string? ""]) diff --git a/collects/scribblings/foreign/com-auto.scrbl b/collects/scribblings/foreign/com-auto.scrbl index 1b1d74ff0c..037ea5ea90 100644 --- a/collects/scribblings/foreign/com-auto.scrbl +++ b/collects/scribblings/foreign/com-auto.scrbl @@ -269,14 +269,17 @@ argument.} information on the symbols.} -@defproc[(com-set-property! [obj com-object?] - [string? property] ...+ +@defproc[(com-set-property! [obj com-object?] + [property (or/c string? + (cons/c string? list?))] ...+ [v any/c]) void?]{ Sets the value of the final property in @racket[obj] to @racket[v] by following the @racket[property]s, where the value of each - intermediate property must be a COM object. + intermediate property must be a COM object. A @racket[property] + can be a list instead of a string to represent a parameterized property + and its arguments. The type of the property is determined via @racket[com-property-type], if possible, and diff --git a/collects/tests/racket/com.rkt b/collects/tests/racket/com.rkt index 25df9dad6a..1d4864fc1e 100644 --- a/collects/tests/racket/com.rkt +++ b/collects/tests/racket/com.rkt @@ -167,4 +167,21 @@ (void)) +;; The Excel interface provides many more opportunities for tests: +(define excel (with-handlers ([exn:fail? (lambda (exn) + (printf "Excel not available\n") + #f)]) + (com-create-instance "Excel.Application"))) +(when excel + (com-set-property! excel "Visible" #t) + (define wb (com-get-property excel "Workbooks")) + (define workbook (com-invoke wb "Add")) + (define sheets (com-get-property workbook "Worksheets")) + (define sheet (com-get-property sheets '("Item" "Sheet1"))) + (define range (com-get-property sheet "Cells")) + (define cell (com-get-property range '("Item" 1 1))) + (com-get-property cell '("Value" 10)) + (com-set-property! cell '("Value" 10) (seconds->date (current-seconds))) + (test #t (date? (com-get-property cell '("Value" 10))))) + (printf "~a passed\n" count)