[racket] Registry renaming keys
Hello,
I write a rename-resource function. I do not claim to any correctness.
It may be very quick and dirty. I write it to my best knowledge and belief, so feel free to correct me cause I am a racket beginner.
[Code_Begin]
#lang racket
(require ffi/com
ffi/unsafe
ffi/unsafe/define
ffi/winapi
racket/string
racket/format)
(define _HKEY (_cpointer/null 'HKEY))
;;------------------------------------------------------------------------------------
(define (const-hkey v)
(cast (bitwise-ior v (arithmetic-shift -1 32)) _intptr _HKEY))
(define HKEY_CLASSES_ROOT (const-hkey #x80000000))
(define HKEY_CURRENT_USER (const-hkey #x80000001))
(define HKEY_LOCAL_MACHINE (const-hkey #x80000002))
(define HKEY_USERS (const-hkey #x80000003))
(define HKEY_CURRENT_CONFIG (const-hkey #x80000005))
(define REG_SZ 1)
(define REG_BINARY 3)
(define REG_DWORD 4)
;;------------------------------------------------------------------------------------
(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 ERROR_SUCCESS #x0)
(define advapi-dll (and (eq? (system-type) 'windows)
(ffi-lib "Advapi32.dll")))
(define-ffi-definer define-advapi advapi-dll
#:default-make-fail make-not-available)
(define-advapi RegOpenKeyExW (_fun #:abi winapi
_HKEY
_string/utf-16
_DWORD
_REGSAM
(hkey : (_ptr o _HKEY))
-> (r : _LONG)
-> (values r hkey )))
(define-advapi RegCreateKeyExW (_fun #:abi winapi
_HKEY
_string/utf-16
(_DWORD = 0)
(_pointer = #f) ; class
_DWORD ; options
_REGSAM
_pointer ; security
(phkey : (_ptr o _HKEY))
(dwDisposition : (_ptr o _DWORD)) ; disposition
-> (r : _LONG)
-> (values r phkey dwDisposition)))
(define-advapi RegCopyTreeW (_fun #:abi winapi
_HKEY
_string/utf-16
_HKEY
-> (r : _LONG)))
(define-advapi RegDeleteKeyExW (_fun #:abi winapi
_HKEY
_string/utf-16
_REGSAM
(_DWORD = 0)
-> (r : _LONG)))
(define-advapi RegDeleteTreeW (_fun #:abi winapi
_HKEY
_string/utf-16
-> (r : _LONG)))
(define-advapi RegCloseKey (_fun #:abi winapi
_HKEY
-> (r : _LONG)))
(define KEY_ALL_ACCESS #xF003F)
(define KEY_WRITE #x20006)
(define REG_OPTION_NON_VOLATILE #x00000000)
(define KEY_WOW64_32KEY #x0200)
(define KEY_WOW64_64KEY #x0100)
(define rename-resource
(lambda (srcPath srcKey destPathWithKeyname)
(define-values (r srctKey) ( RegOpenKeyExW HKEY_LOCAL_MACHINE
srcPath
0
KEY_WRITE))
(define-values (r1
trgKey
dwDisposition) ( RegCreateKeyExW HKEY_LOCAL_MACHINE
destPathWithKeyname
REG_OPTION_NON_VOLATILE
KEY_ALL_ACCESS
#f))
(define r2 ( RegCopyTreeW srctKey
srcKey
trgKey))
(cond [(equal? r2 ERROR_SUCCESS)
(RegDeleteTreeW srctKey srcKey)
]
[else
(error "Error deleting the give key!")])
(RegCloseKey srctKey)
(RegCloseKey trgKey)))
[Code_End]
Yours,