1 ! Copyright (C) 2010 Doug Coleman.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: alien.c-types byte-arrays kernel locals sequences
4 windows.advapi32 windows.errors math windows
5 windows.kernel32 windows.time accessors alien.data
6 windows.types classes.struct continuations ;
9 ERROR: open-key-failed key subkey mode error-string ;
10 ERROR: create-key-failed hKey lpSubKey lpClass dwOptions
11 samDesired lpSecurityAttributes phkResult lpdwDisposition ;
13 CONSTANT: registry-value-max-length 16384
15 :: open-key ( key subkey mode -- hkey )
16 key subkey 0 mode 0 HKEY <ref>
18 RegOpenKeyEx dup ERROR_SUCCESS = [
21 [ key subkey mode ] dip n>win32-error-string
26 :: create-key* ( hKey lpSubKey lpClass dwOptions samDesired lpSecurityAttributes -- hkey new? )
28 hKey lpSubKey 0 lpClass dwOptions samDesired lpSecurityAttributes
31 [ RegCreateKeyEx ret! ] 2keep
33 [ DWORD deref REG_CREATED_NEW_KEY = ] bi*
36 hKey lpSubKey 0 lpClass dwOptions samDesired
38 ] dip n>win32-error-string
39 throw-create-key-failed
42 : create-key ( hkey lsubkey -- hkey )
43 f 0 KEY_ALL_ACCESS f create-key* drop ;
45 : close-key ( hkey -- )
46 RegCloseKey dup ERROR_SUCCESS = [
49 n>win32-error-string throw
52 :: with-open-registry-key ( key subkey mode quot -- )
53 key subkey mode open-key :> hkey
58 :: with-create-registry-key ( key subkey quot -- )
59 key subkey create-key :> hkey
66 : grow-buffer ( byte-array -- byte-array' )
67 length 2 * <byte-array> ;
69 :: reg-query-value-ex ( key subkey ptr1 ptr2 buffer -- buffer )
70 buffer length uint <ref> :> pdword
71 key subkey ptr1 ptr2 buffer pdword [ RegQueryValueEx ] 2keep
76 ret ERROR_MORE_DATA = [
78 key subkey ptr1 ptr2 buffer
79 grow-buffer reg-query-value-ex
81 ret n>win32-error-string throw
97 TUPLE: registry-enum-key ;
100 :: reg-enum-keys ( registry-info -- seq )
101 registry-info sub-keys>> iota [
102 [ registry-info key>> ] dip
103 registry-value-max-length TCHAR <c-array> dup :> registry-value
104 registry-value length dup :> registry-value-length
106 0 DWORD <ref> dup :> type
107 f ! 0 BYTE <ref> dup :> data
108 f ! 0 BYTE <ref> dup :> buffer
109 RegEnumKeyEx dup ERROR_SUCCESS = [
115 :: reg-query-info-key ( key -- n )
118 dup TCHAR <c-array> dup :> class-buffer
119 swap int <ref> dup :> class-buffer-length
121 0 DWORD <ref> dup :> sub-keys
122 0 DWORD <ref> dup :> longest-subkey
123 0 DWORD <ref> dup :> longest-class-string
124 0 DWORD <ref> dup :> #values
125 0 DWORD <ref> dup :> max-value
126 0 DWORD <ref> dup :> max-value-data
127 0 DWORD <ref> dup :> security-descriptor
128 FILETIME <struct> dup :> last-write-time
129 RegQueryInfoKey :> ret
130 ret ERROR_SUCCESS = [
134 longest-subkey uint deref
135 longest-class-string uint deref
138 max-value-data uint deref
139 security-descriptor uint deref
140 last-write-time FILETIME>timestamp
143 ret n>win32-error-string
146 : set-reg-key ( hkey value type lpdata cbdata -- )
148 RegSetValueEx dup ERROR_SUCCESS = [
154 : set-reg-binary ( hkey value lpdata cbdata -- )
155 [ REG_BINARY ] 2dip set-reg-key ;
157 : set-reg-dword ( hkey value lpdata cbdata -- )
158 [ REG_DWORD ] 2dip set-reg-key ;
160 : set-reg-dword-le ( hkey value lpdata cbdata -- )
161 [ REG_DWORD_LITTLE_ENDIAN ] 2dip set-reg-key ;
163 : set-reg-dword-be ( hkey value lpdata cbdata -- )
164 [ REG_DWORD_BIG_ENDIAN ] 2dip set-reg-key ;
166 : set-reg-expand-sz ( hkey value lpdata cbdata -- )
167 [ REG_EXPAND_SZ ] 2dip set-reg-key ;
169 : set-reg-link ( hkey value lpdata cbdata -- )
170 [ REG_LINK ] 2dip set-reg-key ;
172 : set-reg-multi-sz ( hkey value lpdata cbdata -- )
173 [ REG_MULTI_SZ ] 2dip set-reg-key ;
175 : set-reg-none ( hkey value lpdata cbdata -- )
176 [ REG_NONE ] 2dip set-reg-key ;
178 : set-reg-qword ( hkey value lpdata cbdata -- )
179 [ REG_QWORD ] 2dip set-reg-key ;
181 : set-reg-qword-le ( hkey value lpdata cbdata -- )
182 [ REG_QWORD_LITTLE_ENDIAN ] 2dip set-reg-key ;
184 : set-reg-sz ( hkey value lpdata cbdata -- )
185 [ REG_SZ ] 2dip set-reg-key ;
189 : windows-performance-data ( -- byte-array )
190 HKEY_PERFORMANCE_DATA "Global" f f
191 21 2^ <byte-array> reg-query-value-ex ;
193 : read-registry ( key subkey -- registry-info )
194 KEY_READ [ reg-query-info-key ] with-open-registry-key ;