[racket] ffi->SendMessageTimeoutW

From: heraklea at gmx.de (heraklea at gmx.de)
Date: Mon Jan 21 04:53:25 EST 2013

Thank you very much,

but if I understand you right, I make it so:

[Code_Begin]
#lang racket
(require ffi/com
         ffi/unsafe
         ffi/unsafe/define
         ffi/winapi
         racket/string
         racket/format)

(define _HKEY 	(_cpointer/null 'HKEY))
(define _HANDLE (_cpointer/null 'HANDLE))
(define _HWND 	(_cpointer/null 'HWND))
(define _HINSTANCE (_cpointer/null 'HINSTANCE))
(define _LONG       _long)
(define _WORD       _int16)
(define _DWORD      _int32)
(define _REGSAM     _DWORD)
(define _LONG_PTR   _intptr)
(define _LPARAM     _LONG_PTR)
(define _LRESULT    _LONG_PTR)
(define _HRESULT    _LONG)
(define _WPARAM     _intptr)
(define _UINT       _uint)
(define _BOOL       (make-ctype _int (lambda (v) (if v 1 0)) (lambda (v) (not (zero? v)))))

(define SMTO_ABORTIFHUNG        #x0002)
(define SMTO_BLOCK              #x0001)
(define SMTO_NORMAL             #x0000)
(define SMTO_NOTIMEOUTIFNOTHUNG #x0008)
(define SMTO_ERRORONEXIT        #x0020)


(define HWND_BROADCAST (cast #xffff _intptr _HWND))
(define WM_WININICHANGE         #x001A)
(define WM_SETTINGCHANGE        WM_WININICHANGE)

(define kernel-dll (and (eq? (system-type) 'windows)
                        (ffi-lib "Kernel32.dll")))

(define user32-dll (and (eq? (system-type) 'windows)
                        (ffi-lib "User32.dll")))
(define-ffi-definer define-kernel kernel-dll
  #:default-make-fail make-not-available)

(define-ffi-definer define-user32 user32-dll
  #:default-make-fail make-not-available)

(define-kernel GetLastError (_fun #:abi winapi
                                  -> (r : _DWORD)))

(define-user32 SendMessageTimeoutW (_fun #:abi winapi
                                      _HWND
                                      _UINT
                                      _WPARAM
                                      _LPARAM
                                      _UINT
                                      _UINT
                                      (lpdwResult : (_ptr o _DWORD))
                                      -> (r : _long)
                                      -> (values r lpdwResult )))

(define-values (*ENV ENV)
    (let* ([data
            (call-with-output-bytes
             (lambda (out)
               (let ([out (reencode-output-port
                           out (string-append
                                "UTF-16"
                                (if (system-big-endian?)
                                    "BE" "LE")))])
                 (display "Environment\u0000" out)
                 (close-output-port out))))]
           [cdata
            (malloc 'atomic-interior (bytes-length data))])
      (memmove cdata data (bytes-length data))
      (values cdata (cast cdata _pointer _intptr))))
	  
	  
(define-values ( r4 res4) (SendMessageTimeoutW HWND_BROADCAST
                                               WM_SETTINGCHANGE
                                               0
                                               ENV
                                               SMTO_ABORTIFHUNG
                                               5000))
[Code_End]


(GetLastError) is still 3, do I make something wrong?

Yours,

Posted on the users mailing list.