1(module windlldir racket/base 2 (require racket/port 3 racket/promise 4 "winutf16.rkt") 5 6 (provide update-dll-dir 7 get-current-dll-dir 8 current-no-dlls?) 9 10 (define label (delay/sync (byte-regexp (bytes->utf-16-bytes #"dLl dIRECTORy:")))) 11 (define max-dir-len (* 512 2)) ; sizeof(wchar_t) is 2 12 13 (define (update-dll-dir dest path) 14 (let ([path-bytes (bytes->utf-16-bytes 15 (cond [(eq? path #t) #"<system>"] 16 [(path? path) (path->bytes path)] 17 [else (string->bytes/locale path)]))]) 18 (unless ((bytes-length path-bytes) . <= . max-dir-len) 19 (error 'update-dll-dir "path too long: ~e" path)) 20 (let ([m (with-input-from-file dest 21 (lambda () 22 (regexp-match-positions (force label) (current-input-port))))]) 23 (unless m 24 (error 'update-ddl-dir "cannot find DLL path in file: ~e" dest)) 25 (with-output-to-file dest 26 (lambda () 27 (file-position (current-output-port) (cdar m)) 28 (write-bytes path-bytes) 29 (write-byte 0)) 30 #:exists 'update)))) 31 32 (define (get-current-dll-dir dest) 33 (with-input-from-file dest 34 (lambda () 35 (unless (regexp-match (force label) (current-input-port)) 36 (error 'get-current-dll-dir "cannot find DLL path in file: ~e" dest)) 37 (let ([p (make-limited-input-port (current-input-port) max-dir-len)]) 38 (let ([m (regexp-match #rx#"(?:[^\0].|.[^\0])*" p)]) 39 (bytes->path (utf-16-bytes->bytes (car m)))))))) 40 41 (define (current-no-dlls? dest) 42 (regexp-match? #rx#"^<" (get-current-dll-dir dest)))) 43