From 7298918029d54814f8d7ca4dbde380634c16de91 Mon Sep 17 00:00:00 2001 From: Alexander Iljin Date: Wed, 11 Jul 2018 16:58:08 +0700 Subject: [PATCH] windows.registry: add change-registry-value and delete-value --- basis/windows/advapi32/advapi32.factor | 9 +++- basis/windows/registry/authors.txt | 1 + basis/windows/registry/registry-tests.factor | 22 ++++++++- basis/windows/registry/registry.factor | 48 ++++++++++++++++---- 4 files changed, 69 insertions(+), 11 deletions(-) diff --git a/basis/windows/advapi32/advapi32.factor b/basis/windows/advapi32/advapi32.factor index 7f3e878005..0981c55524 100755 --- a/basis/windows/advapi32/advapi32.factor +++ b/basis/windows/advapi32/advapi32.factor @@ -1317,7 +1317,14 @@ FUNCTION: LONG RegDeleteKeyExW ( ALIAS: RegDeleteKeyEx RegDeleteKeyExW ! : RegDeleteValueA ; -! : RegDeleteValueW ; + +FUNCTION: LONG RegDeleteValueW ( + HKEY hKey, + LPCWSTR lpValueName + ) + +ALIAS: RegDeleteValue RegDeleteValueW + ! : RegDisablePredefinedCache ; ! : RegEnumKeyA ; ! : RegEnumKeyExA ; diff --git a/basis/windows/registry/authors.txt b/basis/windows/registry/authors.txt index 7c1b2f2279..d652f68ac8 100644 --- a/basis/windows/registry/authors.txt +++ b/basis/windows/registry/authors.txt @@ -1 +1,2 @@ Doug Coleman +Alexander Ilin diff --git a/basis/windows/registry/registry-tests.factor b/basis/windows/registry/registry-tests.factor index 17662bf75a..839f2eecd3 100644 --- a/basis/windows/registry/registry-tests.factor +++ b/basis/windows/registry/registry-tests.factor @@ -1,7 +1,27 @@ ! Copyright (C) 2010 Doug Coleman. +! Copyright (C) 2018 Alexander Ilin. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel tools.test windows.advapi32 windows.registry ; +USING: byte-arrays io.encodings.string io.encodings.utf16n +kernel sequences tools.test windows.advapi32 windows.kernel32 +windows.registry ; IN: windows.registry.tests [ ] [ HKEY_CURRENT_USER "SOFTWARE\\\\Microsoft" read-registry drop ] unit-test + +[ t ] +[ + HKEY_CURRENT_USER "Environment" KEY_SET_VALUE [ + "factor-test" "value" utf16n encode dup length set-reg-sz + ] with-open-registry-key + HKEY_CURRENT_USER "Environment" "factor-test" [ + "test-string" ";" glue + ] change-registry-value + HKEY_CURRENT_USER "Environment" KEY_QUERY_VALUE [ + "factor-test" f f MAX_PATH reg-query-value-ex + utf16n decode "value;test-string\0" = + ] with-open-registry-key + HKEY_CURRENT_USER "Environment" KEY_SET_VALUE [ + "factor-test" delete-value + ] with-open-registry-key +] unit-test diff --git a/basis/windows/registry/registry.factor b/basis/windows/registry/registry.factor index 465d617a3d..03d2228abf 100644 --- a/basis/windows/registry/registry.factor +++ b/basis/windows/registry/registry.factor @@ -1,9 +1,11 @@ ! Copyright (C) 2010 Doug Coleman. +! Copyright (C) 2018 Alexander Ilin. ! See http://factorcode.org/license.txt for BSD license. -USING: alien.c-types byte-arrays kernel locals sequences -windows.advapi32 windows.errors math windows -windows.kernel32 windows.time accessors alien.data -windows.types classes.struct continuations ; +USING: accessors alien.c-types alien.data byte-arrays +classes.struct continuations io.encodings.string +io.encodings.utf16n kernel literals locals math sequences sets +splitting windows windows.advapi32 windows.errors +windows.kernel32 windows.time windows.types ; IN: windows.registry ERROR: open-key-failed key subkey mode error-string ; @@ -66,22 +68,31 @@ CONSTANT: registry-value-max-length 16384 : grow-buffer ( byte-array -- byte-array' ) length 2 * ; -:: reg-query-value-ex ( key subkey ptr1 ptr2 buffer -- buffer ) +PRIVATE> + +:: reg-query-value-ex ( key value-name ptr1 lpType buffer -- buffer ) buffer length uint :> pdword - key subkey ptr1 ptr2 buffer pdword [ RegQueryValueEx ] 2keep + key value-name ptr1 lpType buffer pdword [ RegQueryValueEx ] 2keep rot :> ret ret ERROR_SUCCESS = [ uint deref head ] [ ret ERROR_MORE_DATA = [ 2drop - key subkey ptr1 ptr2 buffer + key value-name ptr1 lpType buffer grow-buffer reg-query-value-ex ] [ ret n>win32-error-string throw ] if ] if ; +: delete-value ( key value-name -- ) + RegDeleteValue dup ERROR_SUCCESS = [ + drop + ] [ + n>win32-error-string throw + ] if ; + TUPLE: registry-info key class-name @@ -184,11 +195,30 @@ TUPLE: registry-enum-key ; : set-reg-sz ( hkey value lpdata cbdata -- ) [ REG_SZ ] 2dip set-reg-key ; -PRIVATE> - : windows-performance-data ( -- byte-array ) HKEY_PERFORMANCE_DATA "Global" f f 21 2^ reg-query-value-ex ; : read-registry ( key subkey -- registry-info ) KEY_READ [ reg-query-info-key ] with-open-registry-key ; + +:: change-registry-value ( key subkey value-name quot: ( value -- value' ) -- ) + 0 DWORD :> type + key subkey KEY_QUERY_VALUE KEY_SET_VALUE bitor [ + dup :> hkey value-name f type MAX_PATH + reg-query-value-ex + type DWORD deref ${ REG_SZ REG_EXPAND_SZ REG_MULTI_SZ } in? + dup :> string-type? [ + utf16n decode type DWORD deref REG_MULTI_SZ = [ + "\0" split 2 + ] [ 1 ] if head* + ] when + quot call( x -- x' ) + string-type? [ + type DWORD deref REG_MULTI_SZ = [ + "\0" join 2 + ] [ 1 ] if [ CHAR: \0 suffix ] times utf16n encode + ] when + [ hkey value-name type DWORD deref ] dip dup length + set-reg-key + ] with-open-registry-key ; -- 2.34.1