[racket] Registry renaming keys

From: heraklea at gmx.de (heraklea at gmx.de)
Date: Sun Dec 16 19:38:08 EST 2012

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,

Posted on the users mailing list.