adjust ffi/unsafe/com to use ffi/unsafe/string-list
The one-off `_ptr-to-string/utf-16` can be `_string-list/utf-16`.
This commit is contained in:
parent
36195c71f6
commit
98cf4151a9
|
@ -4,6 +4,7 @@
|
|||
ffi/winapi
|
||||
ffi/unsafe/atomic
|
||||
ffi/unsafe/custodian
|
||||
ffi/unsafe/string-list
|
||||
ffi/file
|
||||
racket/date
|
||||
racket/runtime-path
|
||||
|
@ -333,7 +334,7 @@
|
|||
[GetTypeInfo (_hmfun _UINT _LCID (p : (_ptr o _pointer))
|
||||
-> GetTypeInfo (cast p _pointer _ITypeInfo-pointer))
|
||||
#:release-with-function Release]
|
||||
[GetIDsOfNames (_hmfun _REFIID _ptr-to-string/utf-16
|
||||
[GetIDsOfNames (_hmfun _REFIID _string-list/utf-16
|
||||
(_UINT = 1) _LCID
|
||||
(p : (_ptr o _DISPID))
|
||||
-> GetIDsOfNames
|
||||
|
@ -1937,7 +1938,7 @@
|
|||
|
||||
(define (find-memid who obj name)
|
||||
(define-values (r memid)
|
||||
(GetIDsOfNames (com-object-get-dispatch obj) IID_NULL name LOCALE_SYSTEM_DEFAULT))
|
||||
(GetIDsOfNames (com-object-get-dispatch obj) IID_NULL (list name) LOCALE_SYSTEM_DEFAULT))
|
||||
(cond
|
||||
[(zero? r) memid]
|
||||
[(= r DISP_E_UNKNOWNNAME) (error who "unknown method name: ~e" name)]
|
||||
|
|
|
@ -371,29 +371,12 @@
|
|||
2
|
||||
1))))
|
||||
|
||||
(define (string->pointer s [alloc SysAllocStringLen])
|
||||
(define (string->pointer s)
|
||||
(let ([v (malloc _gcpointer)])
|
||||
(ptr-set! v _string/utf-16 s)
|
||||
(let ([p (ptr-ref v _gcpointer)])
|
||||
(let ([len (utf-16-length s)])
|
||||
(alloc p len)))))
|
||||
|
||||
;; Like (_ptr i _string/utf-16), but as a single atomic (and immobile
|
||||
;; and GCable) object, so it can be passed to a function in CS:
|
||||
(define _ptr-to-string/utf-16
|
||||
(make-ctype _gcpointer
|
||||
(lambda (s)
|
||||
(string->pointer
|
||||
s
|
||||
(lambda (p len)
|
||||
(define slen (+ len 2)) ; add terminator
|
||||
(define p2 (malloc 'atomic-interior
|
||||
(+ slen (ctype-sizeof _pointer))))
|
||||
(memcpy p2 (ctype-sizeof _pointer) p slen)
|
||||
(ptr-set! p2 _pointer 0 p)
|
||||
p2)))
|
||||
(lambda (p)
|
||||
(cast p _pointer _string/utf-16))))
|
||||
(SysAllocStringLen p len)))))
|
||||
|
||||
(define _SAFEARRAY-pointer (_cpointer 'SAFEARRAY))
|
||||
|
||||
|
|
Loading…
Reference in New Issue
Block a user